Functional programming: How to convert an implementation of fibonacci written in python to haskell

Question

So, for this task I have to convert python to haskell. The code I have to implement in haskell is a code that generates a fibonacci sequence using a top down iteration method. The problem is that i'm fairly new at haskell, and I don't quite know how to execute this problem.

I have created a while-loop in haskell, and a function.

Python code:

def fib_top_down_iter_with_cache(n, trace=False):
    fibDict = {1:1, 2: 1}
    (inp, stack) = (['fib', n], [])
    fib_top_down_iter_with_cache.function_calls = 0
    while inp:
        if trace: 
            print(fibDict, inp, stack)
        (inp, token) = (inp[:-1], inp[-1])
        if isinstance(token, int):
            stack = [token] + stack
        elif token == 'fib':
            (n, stack) = (stack[0], stack[1:])
            fib_top_down_iter_with_cache.function_calls += 1
            if n in fibDict:
                inp = inp + [fibDict[n]]
            else:
                inp = inp + ['cache', n, '+', 'fib', n - 1, 'fib', n - 2]
        elif token == '+':
            (n1, n2, stack) = (stack[0], stack[1], stack[2:])
            inp = inp + [n1 + n2]
        elif token == 'cache':
            (n1, n2, stack) = (stack[0], stack[1], stack[1:])
            fibDict[n1] = n2
        else:
            raise Exception()
    return stack[0]

What I have tried in haskell:

while :: state -> (state -> Bool) -> (state -> state) -> (state -> result) -> result
while state eval bodyFn extractRes
    | eval state = while (bodyFn state) eval bodyFn extractRes
    | otherwise = extractRes state

data Input
    = Word String | Num Integer
    deriving (Eq, Show)

word :: Input -> String
word (Word x) = x

value :: Input -> Integer
value (Num x) = x

fibTopDownIterWithCache :: Integer -> Integer
fibTopDownIterWithCache n = fibTopDownIterWithCache []
fibTopDownIterWithCache n cache = while ([Word "fib", Num n], [])
                                        (-- Just don't know how to implement the rest)

So, the cache has to be implemented as a Data.Map data type, and I have to attach the cache as an attribute of the function (which i have done, i think). Then I have to pass the cache around as an additional parameter.

The expected value is just the nth fibonacci value.

Answer 1

I'm a little embarrassed in retrospect since you are very clearly asking about the "top-down iteration" technique which I speak none of. Oh well, I hope this is still useful on some level.

A lot of effort in the python code is going into simulating recursion with an explicit stack and a while loop. In Haskell we would just use regular recursion; you're not going to get stack overflows or anything like that¹. The recursive definition of fibonacci is, of course:

fib :: Int -> Integer
fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

Which is quite tiny. All we have to do is add caching to it.

Explicit Cache Passing

If we're trying to stay close to the original code (yet without going all the way to simulating recursion), we should pass our cache around as a parameter. That is, our function will take a cache, and return an updated cache.

type Cache = Map.Map Int Integer

fib :: Int -> Cache -> (Integer, Cache)
fib 0 cache = (0, cache)
fib 1 cache = (1, cache)
fib n cache = 
    let (a, cache') = fib (n-1) cache in 
     ... -- Left as exercise
         -- Since we call fib twice, remember to pass the
         -- *updated* cache, not the original, to the second call

I do recommend this exercise, even though in the next section it will become obsolete.

Digression

It turns out that the pattern of our Cache-passing fib is exactly the pattern that the State monad captures. So we could have written fib as

fib :: Int -> State Cache Integer

Indeed, the definition of State is essentially:

State s a = s -> (a, s)

modulo some newtype nonsense. If we substitute in State Cache Integer, we find that

fib :: Int -> State Cache Integer
    :: Int -> Cache -> (Integer, Cache)

just as our original! So if you did that exercise, you basically know what the State monad does.

Pure Memoization

Passing a cache around is all well and good, but we can do better. Wouldn't it be great to still be able to see the core logic of the original fib definition easily, without worrying about threading a state around? That's what the examples on the Memoization page are talking about:

memoized_fib :: Int -> Integer
memoized_fib = (map fib [0 ..] !!)
   where fib 0 = 0
         fib 1 = 1
         fib n = memoized_fib (n-2) + memoized_fib (n-1)

There is a little slant to this language: we have the "real" fib definition hiding inside the where clause of memoized_fib, and the "real" definition calls back out to its parent memoized_fib. But the original function is still pretty clear and not overwhelmed with little details.

The first line contains an operator section in case you haven't seen that before. It is just syntax sugar and doesn't relate to the memoization technique.

The way this works is the first line creates a (single, program-global²) infinite list

[ fib 0, fib 1, fib 2, fib 3, fib 4, fib 5, ... ]

which, because of laziness, is not evaluated (that would take a long time, wouldn't it?). Then when we need to know a particular fibonacci number, say 4, we index into the list, and thus only evaluate that element. This updates the corresponding thunk (lazily suspended computation)

 [ fib 0, fib 1, fib 2, fib 3, 3, fib 5, ... ]

so that if we ever access the 4th element again, it's already been evaluated. Of course, one of the reasons we ask for fibonacci numbers is to compute other fibonacci numbers (because fib recurses into memoized_fib), so now intermediate results will cached in this list also, and as a result the computation gets an exponential speedup.

Indexing into a list is O(n), because Haskell lists are essentially linked lists. So the memo table has O(n) lookup; we can do better by using a trie. That's what my library data-memocombinators provides, as well as a couple other libraries such as MemoTrie with slightly different perspectives on basically same thing. Using these libraries you can use this same pure memoization technique with an O(log n) memo table. More on the details of that.

So, that's how 26 lines of Python becomes 5 lines³ of Haskell. Happy Hasking!

---

¹ Stack overflows can happen in Haskell, but it's not because your recursion is too deep, it's usually because you were a bit too lazy and need to force something somewhere.`

² The technical word is Constant Applicative Form or CAF, if you want to find out more.

³ And still 4 too many.

fibs = 0 : scanl (+) 1 fibs

Answer 2

I think the answer to this question really shows a place where Haskell shines: in the design and implementation of domain-specific languages. Where the Python uses strings and reflection, we'll use algebraic data types to represent the commands in the language, making the implementation clean and easy to check for completeness (plus the compiler will let you know if you made a typo in one of the commands, unlike the Python version!).

First let's define the language we're interpreting. Since Fibonacci numbers get big fast, we'll just use bignums everywhere to avoid having to think about integer arithmetic overflow.

import Data.Map (Map)
import qualified Data.Map as M

data Command = Push Integer | Plus | Fib | Cache  deriving (Eq, Ord, Read, Show)

(I'd be tempted to give Integer arguments to Fib and Cache as well, rather than forcing a Push onto the stack before each of the calls, but we'll keep it this way for consistency with the original Python code.)

Our stack machine will just use a plain list for its stack, and the environment will be a Map. The state of our stack machine will include the commands to run, the stack, and the cache.

data Machine = Machine
    { program :: [Command]
    , cache   :: Map Integer Integer
    , stack   :: [Integer]
    } 
    deriving (Eq, Ord, Read, Show)

With the preliminaries out of the way, we can write the function which takes one machine step.

step :: Machine -> Machine
step m = case program m of
    []   -> m
    c:cs -> case (c, stack m) of
        (Push n, ns)   -> m { program = cs, stack = n:ns }
        (Plus, a:b:ns) -> m { program = cs, stack = a+b:ns }
        (Fib, n:ns) -> case M.lookup n (cache m) of
            Just fibn -> m { program = cs, stack = fibn:ns }
            Nothing   -> m { stack = ns, program
                = Push (n-2) : Fib
                : Push (n-1) : Fib
                : Plus
                : Push n : Cache
                : cs
                }
        (Cache, n:ns@(fibn:_)) -> m
            { program = cs
            , stack = ns
            , cache = M.insert n fibn (cache m)
            }
        _ -> error $ "stack too short for command " ++ show c

Running a program in full is easy: just keep stepping until the program is []. So:

interpret :: Machine -> Machine
interpret = until (null . program) step

Now we can set up a little wrapper that creates a machine with a mostly-empty cache, sets it running, and has a look at the stack when it's done.

fibMachine :: Integer -> Machine
fibMachine n = Machine
    { program = [Fib]
    , cache = M.fromList [(1,1), (2,1)]
    , stack = [n]
    }

fib :: Integer -> Integer
fib = head . stack . interpret . fibMachine

Give it a whirl:

> fib 10
55

Note that we didn't incorporate tracing into interpret. But that's okay; we can add tracing completely externally, like this:

tracingInterpret :: Machine -> IO Machine
tracingInterpret m = mapM_ print unfinished >> return finished 
    where 
    (unfinished, finished:_) = break (null . program) (iterate step m)

Try it:

> tracingInterpret (fibMachine 4)
Machine {program = [Fib], cache = fromList [(1,1),(2,1)], stack = [4]}
Machine {program = [Push 2,Fib,Push 3,Fib,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = []}
Machine {program = [Fib,Push 3,Fib,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [2]}
Machine {program = [Push 3,Fib,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [1]}
Machine {program = [Fib,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [3,1]}
Machine {program = [Push 1,Fib,Push 2,Fib,Plus,Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [1]}
Machine {program = [Fib,Push 2,Fib,Plus,Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [1,1]}
Machine {program = [Push 2,Fib,Plus,Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [1,1]}
Machine {program = [Fib,Plus,Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [2,1,1]}
Machine {program = [Plus,Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [1,1,1]}
Machine {program = [Push 3,Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [2,1]}
Machine {program = [Cache,Plus,Push 4,Cache], cache = fromList [(1,1),(2,1)], stack = [3,2,1]}
Machine {program = [Plus,Push 4,Cache], cache = fromList [(1,1),(2,1),(3,2)], stack = [2,1]}
Machine {program = [Push 4,Cache], cache = fromList [(1,1),(2,1),(3,2)], stack = [3]}
Machine {program = [Cache], cache = fromList [(1,1),(2,1),(3,2)], stack = [4,3]}
Machine {program = [], cache = fromList [(1,1),(2,1),(3,2),(4,3)], stack = [3]}