Using dynamic programming in Haskell? [Warning: ProjectEuler 31 solution inside]

Question

When solving projecteuler.net problem number 31 [ SPOILERS AHEAD ] (counting the number of ways to make £ 2 with British coins), I wanted to use dynamic programming. I started with OCaml and wrote the short and very effective following programming:

open Num let make_dyn_table amount coins = let t = Array.make_matrix (Array.length coins) (amount+1) (Int 1) in for i = 1 to (Array.length t) - 1 do for j = 0 to amount do if j < coins.(i) then t.(i).(j) <- t.(i-1).(j) else t.(i).(j) <- t.(i-1).(j) +/ t.(i).(j - coins.(i)) done done; t let _ = let t = make_dyn_table 200 [|1;2;5;10;20;50;100;200|] in let last_row = Array.length t - 1 in let last_col = Array.length t.(last_row) - 1 in Printf.printf "%s\n" (string_of_num (t.(last_row).(last_col))) 

This runs in ~ 8 ms on my laptop. If I increase the amount from 200 pence to a million, the program will still find the answer in less than two seconds.

I transferred the program to Haskell (which was definitely not funny in itself), and although it ends up with the correct answer for 200 pence, if I increase this number to 10,000, my laptop comes to a screeching stop (a lot of beating). Here is the code:

 import Data.Array createDynTable :: Int -> Array Int Int -> Array (Int, Int) Int createDynTable amount coins = let numCoins = (snd . bounds) coins t = array ((0, 0), (numCoins, amount)) [((i, j), 1) | i <- [0 .. numCoins], j <- [0 .. amount]] in t populateDynTable :: Array (Int, Int) Int -> Array Int Int -> Array (Int, Int) Int populateDynTable t coins = go t 1 0 where go tij | i > maxX = t | j > maxY = go t (i+1) 0 | j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1) | otherwise = go (t // [((i, j), t!(i-1,j) + t!(i, j - coins!i))]) i (j+1) ((_, _), (maxX, maxY)) = bounds t changeCombinations amount coins = let coinsArray = listArray (0, length coins - 1) coins dynTable = createDynTable amount coinsArray dynTable' = populateDynTable dynTable coinsArray ((_, _), (i, j)) = bounds dynTable in dynTable' ! (i, j) main = print $ changeCombinations 200 [1,2,5,10,20,50,100,200] 

I would like to hear from someone who knows Haskell well why the performance of this solution is so poor.

Answer 1

Haskell is clean. Cleanliness means that the values ​​are immutable and therefore at the stage

 j < coins ! i = go (t // [((i, j), t ! (i-1, j))]) i (j+1) 

you create a whole new array for each updated record. It is already very expensive for a small amount, for example, £ 2, but it becomes completely obscene in the amount of £ 100.

In addition, arrays are placed in boxes, which means that they contain pointers to records, which degrades locality, uses more storage and allows you to create grottoes, which are also slower to evaluate when they are finally forced.

The algorithm used depends on the variable data structure for its efficiency, but the variability is limited to calculation, so we can use what is intended to provide safely shielded calculations with temporarily changing data, the ST state transformer family, and associated arrays [unboxed, for efficiency] .

Give me half an hour or so to translate the algorithm into code using STUArray s, and you will get a version of Haskell that is not too ugly and should compare with the version of O'Caml (a few more or less constant coefficients, expected for a difference, whether more or less than 1, I do not know).

Here he is:

 module Main (main) where import System.Environment (getArgs) import Data.Array.ST import Control.Monad.ST import Data.Array.Unboxed standardCoins :: [Int] standardCoins = [1,2,5,10,20,50,100,200] changeCombinations :: Int -> [Int] -> Int changeCombinations amount coins = runST $ do let coinBound = length coins - 1 coinsArray :: UArray Int Int coinsArray = listArray (0, coinBound) coins table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int) let go ij | i > coinBound = readArray table (coinBound,amount) | j > amount = go (i+1) 0 | j < coinsArray ! i = do v <- readArray table (i-1,j) writeArray table (i,j) v go i (j+1) | otherwise = do v <- readArray table (i-1,j) w <- readArray table (i, j - coinsArray!i) writeArray table (i,j) (v+w) go i (j+1) go 1 0 main :: IO () main = do args <- getArgs let amount = case args of a:_ -> read a _ -> 200 print $ changeCombinations amount standardCoins 

doesn't work too long

 $ time ./mutArr 73682 real 0m0.002s user 0m0.000s sys 0m0.001s $ time ./mutArr 1000000 986687212143813985 real 0m0.439s user 0m0.128s sys 0m0.310s 

and uses verified calls to the array, using unverified calls, the time can be slightly reduced.

---

Ah, I just found out that your O'Caml code uses arbitrary precision integers, so using Int in Haskell puts O'Caml at an unfair disadvantage. The changes needed to calculate Integer arbitrary precision results are minmal,

 $ diff mutArr.hs mutArrIgr.hs 12c12 < changeCombinations :: Int -> [Int] -> Int --- > changeCombinations :: Int -> [Int] -> Integer 17c17 < table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STUArray s (Int,Int) Int) --- > table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer) 28c28 < writeArray table (i,j) (v+w) --- > writeArray table (i,j) $! (v+w) 

only two type signatures needed to be signed - the array is necessarily inserted in the box, so we need to make sure that we do not write tricks to the array on line 28, but

 $ time ./mutArrIgr 73682 real 0m0.002s user 0m0.000s sys 0m0.002s $ time ./mutArrIgr 1000000 99341140660285639188927260001 real 0m1.314s user 0m1.157s sys 0m0.156s 

computing with a large result that overflows for Int will be noticeably longer, but, as expected, comparable to O'Caml.

---

Having spent some time understanding O'Caml, I can offer a closer, slightly shorter, and possibly more enjoyable translation:

 module Main (main) where import System.Environment (getArgs) import Data.Array.ST import Control.Monad.ST import Data.Array.Unboxed import Control.Monad (forM_) standardCoins :: [Int] standardCoins = [1,2,5,10,20,50,100,200] changeCombinations :: Int -> [Int] -> Integer changeCombinations amount coins = runST $ do let coinBound = length coins - 1 coinsArray :: UArray Int Int coinsArray = listArray (0, coinBound) coins table <- newArray((0,0),(coinBound, amount)) 1 :: ST s (STArray s (Int,Int) Integer) forM_ [1 .. coinBound] $ \i -> forM_ [0 .. amount] $ \j -> if j < coinsArray!i then do v <- readArray table (i-1,j) writeArray table (i,j) v else do v <- readArray table (i-1,j) w <- readArray table (i, j - coinsArray!i) writeArray table (i,j) $! (v+w) readArray table (coinBound,amount) main :: IO () main = do args <- getArgs let amount = case args of a:_ -> read a _ -> 200 print $ changeCombinations amount standardCoins 

which works about equally fast:

 $ time ./mutArrIgrM 1000000 99341140660285639188927260001 real 0m1.440s user 0m1.273s sys 0m0.164s 

Answer 2

You could take advantage of Haskell's lazy and not plan to fill the array, but instead rely on a lazy evaluation to do it in the correct order. (For larger inputs, you need to increase the size of the stack.)

 import Data.Array createDynTable :: Integer -> Array Int Integer -> Array (Int, Integer) Integer createDynTable amount coins = let numCoins = (snd . bounds) coins t = array ((0, 0), (numCoins, amount)) [((i, j), go ij) | i <- [0 .. numCoins], j <- [0 .. amount]] go ij | i == 0 = 1 | j < coins ! i = t ! (i-1, j) | otherwise = t ! (i-1, j) + t ! (i, j - coins!i) in t changeCombinations amount coins = let coinsArray = listArray (0, length coins - 1) coins dynTable = createDynTable amount coinsArray ((_, _), (i, j)) = bounds dynTable in dynTable ! (i, j) main = print $ changeCombinations 200 [1,2,5,10,20,50,100,200]