Memoize Project Euler 116 in Haskell

Question

Below is my first attempt at this problem. It is basically a transliteration of my C++ solution, minus a global hash table used to memoize the results of function f.

f :: Int -> Int -> Int
f blocksize spaces
    | blocksize > spaces = 0
    | blocksize == spaces = 1
    | otherwise = 1 + fIter blocksize (spaces - blocksize)

fIter :: Int -> Int -> Int
fIter blocksize spaces =
    sum $ map (f blocksize) [1..spaces]

main :: IO ()
main = do
    let spaces = 50
    print $ fIter 2 spaces + fIter 3 spaces + fIter 4 spaces

I think I understand the basic idea of creating a lazy data structure that is filled in as necessary, as in this type of thing, but what's throwing me here is that there are two mutually-recursive functions that call each other rather than one. I've tried combining them into one form, as below, but haven't had any luck getting it straight in my head yet. Any tips?

fIter2 :: Int -> Int -> Int
fIter2 b s = sum $ map (\i -> memos ! i) [1..s]
    where
        memos = listArray (1, s) (map (f b) [1..s])
        f blocksize spaces
          | blocksize > spaces = 0
          | blocksize == spaces = 1
          | otherwise = 1 + fIter2 blocksize (spaces - blocksize)

(I'm aware that there is a combinatoric solution to this problem, but I'm more interested in getting better at dynamic programming in Haskell right now.)

Answer 1

f is a very simple function. Assuming fIter is easy to compute, f will also be easy to compute. We don't need to memoize f. Our only goal will be to memoize fIter.

When starting to memoize a recursive function in Haskell, it's useful to write the function in open-recursive form. The open recursive form of a function removes explicit recursion and instead adds an extra argument for what to do when the function needs to call itself recursively. This will give us a way to change how the function recursively calls itself.

We'll change the signature of fIter from the first type to the second type

                      The type of fIter
                       v
                       Int -> Int -> Int
(Int -> Int -> Int) -> Int -> Int -> Int
 ^                     ^
 |                     Gets back something with the type of fIter
 What to do when fIter needs to call itself recursively

fIter calls itself recursively through f, so we'll first add the (Int -> Int -> Int) argument for how to call fIter to f

f' :: (Int -> Int -> Int) -> Int -> Int -> Int
f' r blocksize spaces
    | blocksize > spaces = 0
    | blocksize == spaces = 1
    | otherwise = 1 + r blocksize (spaces - blocksize)

The modified fIter' will pass how to recursively call itself (that it got from the new argument) as the new argument to f'.

fIter' :: (Int -> Int -> Int) -> Int -> Int -> Int
fIter' r blocksize spaces =
    sum $ map (f' r blocksize) [1..spaces]

We can recover the original slow fIter by fixing it with fix :: (a -> a) -> a defined in Data.Function as fix f = let x = f x in x.

fIter :: Int -> Int -> Int
fIter = fix fIter'

Now we're in a good place to change how fIter calls itself. Another "lazy data structure that is filled in as necessary" is provided in Data.MemoTrie in the MemoTrie package. It provides two functions that are interesting to us. trie :: HasTrie a => (a -> b) -> a :->: b builds a lazy data structure built from the supplied function. untrie :: HasTrie a => (a :->: b) -> a -> b returns a function that looks up the arguments from the lazy data structure. These only work for certain argument types HasTrie a for which a lazy data structure can be built. Fortunately for our problem there are already instances for HasTrie Int and (HasTrie a, HasTrie b) => HasTrie (a, b).

trie from Data.MemoTrie only accepts a single argument, so we are going to need to pack the two arguments to fIter up in to a single argument. We'd normally do this with uncurry, but, since fIter' needs to take something with the same type as its result as an argument, we also need to curry the recursive call to unpack the arguments. uncurryOr will uncurry any open recursive function.

uncurryOR :: (( a -> b  -> c) ->  a -> b  -> c) ->
              ((a,   b) -> c) -> (a,   b) -> c
uncurryOR or = uncurry . or . curry

Applying this to fIter' yields a satisfying result, uncurryOR fIter' :: ((Int, Int) -> Int) -> (Int, Int) -> Int.

To memoize an open recursive function in general, we build a trie for the open recursive function passing in trie lookup as how the function should get its recursive results.

import Data.MemoTrie

memoOR :: HasTrie a => ((a -> b) -> a -> b) ->
                                    a -> b
memoOR or = f
    where
        f = untrie t
        t = trie (or f)

We can write memoOR more elegantly in terms of fix and memo = untrie . trie from Data.MemoTrie.

memoOR or = fix (memo . or)

We can now define how to compute fIter efficiently

fIter :: Int -> Int -> Int
fIter = curry . memoOR .  uncurryOR $ fIter'