[Haskell-cafe] Re: speeding up fibonacci with memoizing
Jón Fairbairn
jon.fairbairn at cl.cam.ac.uk
Tue Feb 20 11:54:34 EST 2007
"Thomas Hartman" <tphyahoo at gmail.com> writes:
-> I just thought this was interesting, so I would share it.
-> -- versus, try memoized_fibs !! 10000
-> memoized_fibs = map memoized_fib [1..]
-> memoized_fib = ((map fib' [0 ..]) !!)
-> where
-> fib' 0 = 0
-> fib' 1 = 1
-> fib' n = memoized_fib (n - 1) + memoized_fib (n - 2)
I can't let this thread go by without commenting that you
can do something a bit more general by providing a memoising
fixpoint operator that you can reuse for your other awkward
recursive functions:
> module MemoFib where
The unexciting version
> naive_fib 0 = 1
> naive_fib 1 = 1
> naive_fib n = naive_fib (n-1) + naive_fib (n-2)
The memoised version using a memoising fixpoint operator
> fibonacci
> = memoFix fib
> where fib fib 0 = 1
> fib fib 1 = 1
> fib fib n = fib (n-1) + fib (n-2)
I suppose if you want to "put it in a library", you should
just put fib in, and allow the user to call memoFix fib to
make a new version when necessary?
A memoising fixpoint operator. It works by putting the
result of the first call of the function for each natural
number into a data structure and using that value for
subsequent calls ;-)
> memoFix f
> = mf
> where memo = fmap (f mf) (naturals 1 0)
> mf = (memo !!!)
A data structure with a node corresponding to each natural
number to use as a memo.
> data NaturalTree a = Node a (NaturalTree a) (NaturalTree a)
Map the nodes to the naturals in this order:
0
1 2
3 5 4 6
7 ...
Look up the node for a particular number
> Node a tl tr !!! 0 = a
> Node a tl tr !!! n | odd n = tl !!! top
> | otherwise = tr !!! (top-1)
> where top = n `div` 2
We surely want to ba able to map on these things...
> instance Functor NaturalTree where
> fmap f (Node a tl tr) = Node (f a) (fmap f tl) (fmap f tr)
If only so that we can write cute, but inefficient things
like the below, which is just a NaturalTree such that
naturals!!!n == n:
naturals = Node 0 (fmap ((+1).(*2)) naturals) (fmap ((*2).(+1)) naturals)
The following is probably more efficient (and, having
arguments won't hang around at top level, I think) -- have I
put more $!s than necessary?
> naturals r n = Node n ((naturals $! r2) $! (n+r))
> ((naturals $! r2) $! (n+r2))
> where r2 = 2*r
Of course, if you want to take advantage of the pseudo O(n)
lookup time of arrays, you could use a NaturalTree of arrays
of some fixed size -- but arrays are O(log n) really...
--
Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
More information about the Haskell-Cafe
mailing list