Note to self: solving a dynamic programming problem using löb. Literate Haskell source for this post is here: DPloeb.lhs.

module DPloeb where

The first solution is taken from http://blog.mno2.org/blog/2011/11/28/writing-dynamic-programming-in-haskell.

coins :: [Int]
coins = [1, 2, 5, 10, 20, 50, 100, 200]

sol1 :: Int -> Int
sol1 = (!!) (ways2 coins)
    where ways1 [] = 1 : repeat 0
          ways1 (c:cs) = n
              where n = zipWith (+) (ways1 cs) (replicate c 0 ++ n)

main1 :: IO ()
main1 = print $ sol1 200

There are 73682 ways to select coins of the denominations specified in coins that sum to 200:

*DPloeb> main1
73682

First step: roll out the parameter to way:

ways2 :: [Int] -> [Int]
ways2 [] = 1 : repeat 0

ways2 [1, 2, 5, 10, 20, 50, 100, 200] = n
    where c  = 1
          cs = [2, 5, 10, 20, 50, 100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [2, 5, 10, 20, 50, 100, 200] = n
    where c  = 2
          cs = [5, 10, 20, 50, 100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [5, 10, 20, 50, 100, 200] = n
    where c  = 5
          cs = [10, 20, 50, 100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [10, 20, 50, 100, 200] = n
    where c  = 10
          cs = [20, 50, 100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [20, 50, 100, 200] = n
    where c  = 20
          cs = [50, 100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [50, 100, 200] = n
    where c  = 50
          cs = [100, 200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [100, 200] = n
    where c  = 100
          cs = [200]
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

ways2 [200] = n
    where c  = 200
          cs = []
          n  = zipWith (+) (ways2 cs) (replicate c 0 ++ n)

sol2 :: Int -> Int
sol2 = (!!) (ways2 [1,2,5,10,20,50,100,200])

main2 :: IO ()
main2 = print $ sol2 200

Next, change the parameter from [Int] to Int by indexing on integers instead of various lists:

ways3 :: Int -> [Int]

ways3 0 = 1 : repeat 0

ways3 1 = n
    where c  = 1
          cs = 2
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 2 = n
    where c  = 2
          cs = 3
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 3 = n
    where c  = 5
          cs = 4
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 4 = n
    where c  = 10
          cs = 5
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 5 = n
    where c  = 20
          cs = 6
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 6 = n
    where c  = 50
          cs = 7
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 7 = n
    where c  = 100
          cs = 8
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

ways3 8 = n
    where c  = 200
          cs = 0
          n  = zipWith (+) (ways3 cs) (replicate c 0 ++ n)

sol3 :: Int -> Int
sol3 x = ways3 1 !! x

main3 :: IO ()
main3 = print $ sol3 200

Substitute the value of cs in the body of the where clauses:

sol4 :: [Int]
sol4 = ways1
  where

  ways0 = 1 : repeat 0

  ways1 = n
      where c  = 1
            n  = zipWith (+) ways2 (replicate c 0 ++ n)

  ways2 = n
      where c  = 2
            n  = zipWith (+) ways3 (replicate c 0 ++ n)

  ways3 = n
      where c  = 5
            n  = zipWith (+) ways4 (replicate c 0 ++ n)

  ways4 = n
      where c  = 10
            n  = zipWith (+) ways5 (replicate c 0 ++ n)

  ways5 = n
      where c  = 20
            n  = zipWith (+) ways6 (replicate c 0 ++ n)

  ways6 = n
      where c  = 50
            n  = zipWith (+) ways7 (replicate c 0 ++ n)

  ways7 = n
      where c  = 100
            n  = zipWith (+) ways8 (replicate c 0 ++ n)

  ways8 = n
      where c  = 200
            n  = zipWith (+) ways0 (replicate c 0 ++ n)

main4 :: IO ()
main4 = print $ sol4 !! 200

Substitute the value of c in the body of the where clauses:

sol5 :: [Int]
sol5 = ways1
  where
  ways0 = 1 : repeat 0

  ways1 = zipWith (+) ways2 (replicate 1   0 ++ ways1)
  ways2 = zipWith (+) ways3 (replicate 2   0 ++ ways2)
  ways3 = zipWith (+) ways4 (replicate 5   0 ++ ways3)
  ways4 = zipWith (+) ways5 (replicate 10  0 ++ ways4)
  ways5 = zipWith (+) ways6 (replicate 20  0 ++ ways5)
  ways6 = zipWith (+) ways7 (replicate 50  0 ++ ways6)
  ways7 = zipWith (+) ways8 (replicate 100 0 ++ ways7)
  ways8 = zipWith (+) ways0 (replicate 200 0 ++ ways8)

main5 :: IO ()
main5 = print $ sol5 !! 200

Now tweak the type and collect each of the clauses into a list:

ways6 :: [[Int]]
ways6 = let ways0 = 1 : repeat 0
            ways1 = zipWith (+) ways2 (replicate 1   0 ++ ways1)
            ways2 = zipWith (+) ways3 (replicate 2   0 ++ ways2)
            ways3 = zipWith (+) ways4 (replicate 5   0 ++ ways3)
            ways4 = zipWith (+) ways5 (replicate 10  0 ++ ways4)
            ways5 = zipWith (+) ways6 (replicate 20  0 ++ ways5)
            ways6 = zipWith (+) ways7 (replicate 50  0 ++ ways6)
            ways7 = zipWith (+) ways8 (replicate 100 0 ++ ways7)
            ways8 = zipWith (+) ways0 (replicate 200 0 ++ ways8)
            ways = [ways0, ways1, ways2, ways3, ways4, ways5, ways6, ways7, ways8]
            in ways

sol6 :: Int -> Int
sol6 x = ways6 !! 1 !! x

main6 :: IO ()
main6 = print $ sol6 200

Instead of referring to whys4, index into the list with why !! 4:

ways7 :: [[Int]]
ways7 = let ways0 = 1 : repeat 0
            ways1 = zipWith (+) (ways !! 2) (replicate 1   0 ++ (ways !! 1))
            ways2 = zipWith (+) (ways !! 3) (replicate 2   0 ++ (ways !! 2))
            ways3 = zipWith (+) (ways !! 4) (replicate 5   0 ++ (ways !! 3))
            ways4 = zipWith (+) (ways !! 5) (replicate 10  0 ++ (ways !! 4))
            ways5 = zipWith (+) (ways !! 6) (replicate 20  0 ++ (ways !! 5))
            ways6 = zipWith (+) (ways !! 7) (replicate 50  0 ++ (ways !! 6))
            ways7 = zipWith (+) (ways !! 8) (replicate 100 0 ++ (ways !! 7))
            ways8 = zipWith (+) (ways !! 0) (replicate 200 0 ++ (ways !! 8))
            ways = [ways0, ways1, ways2, ways3, ways4, ways5, ways6, ways7, ways8]
            in ways

sol7 :: Int -> Int
sol7 x = ways7 !! 1 !! x

main7 :: IO ()
main7 = print $ sol7 200

Now we can define ways directly as a list:

ways8 :: [[Int]]
ways8 = let ways = [ 1 : repeat 0
                   , zipWith (+) (ways !! 2) (replicate 1   0 ++ (ways !! 1))
                   , zipWith (+) (ways !! 3) (replicate 2   0 ++ (ways !! 2))
                   , zipWith (+) (ways !! 4) (replicate 5   0 ++ (ways !! 3))
                   , zipWith (+) (ways !! 5) (replicate 10  0 ++ (ways !! 4))
                   , zipWith (+) (ways !! 6) (replicate 20  0 ++ (ways !! 5))
                   , zipWith (+) (ways !! 7) (replicate 50  0 ++ (ways !! 6))
                   , zipWith (+) (ways !! 8) (replicate 100 0 ++ (ways !! 7))
                   , zipWith (+) (ways !! 0) (replicate 200 0 ++ (ways !! 8))
                   ]
            in ways

sol8 :: Int -> Int
sol8 x = ways8 !! 1 !! x

main8 :: IO ()
main8 = print $ sol8 200

Factor out whys by writing each list element as a function.

ways9 :: [[Int]]
ways9 = let fs   = [ const $ 1 : repeat 0
                   , \w -> zipWith (+) (w !! 2) (replicate 1   0 ++ (w !! 1))
                   , \w -> zipWith (+) (w !! 3) (replicate 2   0 ++ (w !! 2))
                   , \w -> zipWith (+) (w !! 4) (replicate 5   0 ++ (w !! 3))
                   , \w -> zipWith (+) (w !! 5) (replicate 10  0 ++ (w !! 4))
                   , \w -> zipWith (+) (w !! 6) (replicate 20  0 ++ (w !! 5))
                   , \w -> zipWith (+) (w !! 7) (replicate 50  0 ++ (w !! 6))
                   , \w -> zipWith (+) (w !! 8) (replicate 100 0 ++ (w !! 7))
                   , \w -> zipWith (+) (w !! 0) (replicate 200 0 ++ (w !! 8))
                   ]
            ways = map ($ ways) fs
            in ways

sol9 :: Int -> Int
sol9 x = ways9 !! 1 !! x

main9 :: IO ()
main9 = print $ sol9 200

Now use loeb:

loeb :: Functor f => f (f b -> b) -> f b
loeb fs = go where go = fmap ($ go) fs

fs10 :: [[[Int]] -> [Int]]
fs10   = [ const $ 1 : repeat 0
         , \w -> zipWith (+) (w !! 2) (replicate 1   0 ++ (w !! 1))
         , \w -> zipWith (+) (w !! 3) (replicate 2   0 ++ (w !! 2))
         , \w -> zipWith (+) (w !! 4) (replicate 5   0 ++ (w !! 3))
         , \w -> zipWith (+) (w !! 5) (replicate 10  0 ++ (w !! 4))
         , \w -> zipWith (+) (w !! 6) (replicate 20  0 ++ (w !! 5))
         , \w -> zipWith (+) (w !! 7) (replicate 50  0 ++ (w !! 6))
         , \w -> zipWith (+) (w !! 8) (replicate 100 0 ++ (w !! 7))
         , \w -> zipWith (+) (w !! 0) (replicate 200 0 ++ (w !! 8))
         ]

sol10 :: Int -> Int
sol10 x = loeb fs10 !! 1 !! x

main10 :: IO ()
main10 = print $ sol10 200

Finally, we can generalise this solution by writing a function to produce the elements of fs10:

make :: [Int] -> Int -> ([[Int]] -> [Int])
make _  0 = const $ 1 : repeat 0
make cs k = if k == length cs
                then \w -> zipWith (+) (w !! 0)     (replicate (cs !! (k-1)) 0 ++ (w !! k))
                else \w -> zipWith (+) (w !! (k+1)) (replicate (cs !! (k-1)) 0 ++ (w !! k))

sol11 :: Int -> Int
sol11 x = result !! 1 !! x
  where result = loeb $ map (make coins) [0..length coins]

main11 :: IO ()
main11 = print $ sol11 200

These all say 73682:

mains :: IO ()
mains = do main1
           main2
           main3
           main4
           main5
           main6
           main7
           main8
           main9
           main10
           main11