# carlohamalainen/playground

Fetching contributors…
Cannot retrieve contributors at this time
330 lines (301 sloc) 10.4 KB


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