[Haskell-cafe] Fibonacci numbers generator in Haskell
Jon Fairbairn
jon.fairbairn at cl.cam.ac.uk
Fri Jun 16 13:11:52 EDT 2006
On 2006-06-15 at 17:33BST "Vladimir Portnykh" wrote:
> Fibonacci numbers implementations in Haskell one of the classical examples.
> An example I found is the following:
>
> fibs :: [Int]
> fibs = 0 : 1 : [ a + b | (a, b) <- zip fibs (tail fibs)]
>
> Can we do better?
Well, you've had various variously sensible responses, so
here's one with /worse/ space performance (but a degree of
cuteness):
module Main where
import InfiniteMap
fib = memo fib'
where fib' fib 0 = 0
fib' fib 1 = 1
fib' fib n = fib (n-1) + fib (n-2)
memo f = f memf
where memf n = locate n m
m = build $ f memf
---
module InfiniteMap where
data IM t = Node {entry:: t, if_even::IM t, if_odd:: IM t}
build f = Node (f 0)
(build $ f . (*2))
(build $ f . (+1) . (*2))
locate 0 (Node e _ _) = e
locate n (Node _ e o)
| even n = locate (n`div`2) e
| otherwise = locate ((n-1)`div`2) o
--
Jón Fairbairn Jon.Fairbairn at cl.cam.ac.uk
More information about the Haskell-Cafe
mailing list