68 lines
1.6 KiB
Forth
68 lines
1.6 KiB
Forth
\ compute the nth fibonacci number, starting at 0
|
|
: fib ( n -- n2 )
|
|
dup ( n n )
|
|
2 < if
|
|
drop 1 ( 1 )
|
|
else
|
|
dup 2 - recurse ( n fib[n-2] )
|
|
swap ( fib[n-2] n )
|
|
1 - recurse ( fib[n-2] fib[n-1] )
|
|
+ ( n2 )
|
|
endif ;
|
|
|
|
create memo 100 cells allot
|
|
|
|
\ initialize it
|
|
: init ( n -- )
|
|
dup ( n n )
|
|
if ( n )
|
|
dup 0 swap ( n 0 n )
|
|
1 - ( n 0 n-1 )
|
|
cells memo + ( n n-1+memo )
|
|
1 - ( n 0 n-1+memo)
|
|
! ( n )
|
|
1 - ( n-1 )
|
|
recurse
|
|
else
|
|
drop
|
|
endif ;
|
|
|
|
: fib2x ( n -- n2 )
|
|
dup ( n n )
|
|
2 < if ( n )
|
|
drop 1 ( 1 )
|
|
else
|
|
dup cells memo + ( n n+memo )
|
|
@ ( n ${n+memo} )
|
|
dup 0 > if ( n ${n+memo} )
|
|
swap drop ( ${n+memo} )
|
|
else
|
|
drop ( n )
|
|
dup dup ( n n n )
|
|
2 - recurse ( n n fib2[n-2] )
|
|
swap ( n fib2[n-2] n )
|
|
1 - recurse ( n fib2[n-2] fib2[n-1] )
|
|
+ ( n fib2[n] )
|
|
dup rot ( fib2[n] fib2[n] n )
|
|
cells memo + ! ( fib2[n] )
|
|
endif
|
|
endif ;
|
|
|
|
: fib2
|
|
\ allocate a lookup table and run fib2x
|
|
100 init fib2x ;
|
|
|
|
: expx ( total n n2 -- total*n^n2 )
|
|
?dup if ( total n n2 )
|
|
swap rot ( n2 n total )
|
|
over * ( n2 n total*n )
|
|
swap rot 1- ( n*total n n2-1 )
|
|
recurse
|
|
else ( total n )
|
|
drop ( total )
|
|
endif ;
|
|
|
|
: exp ( n n2 -- n^n2 )
|
|
1 rot rot ( 1 n n2 )
|
|
expx ; ( 1*n^n2 )
|