Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Haskell: How to memoize this algorithm?

I wrote this solution to the coin change problem on HackerRank:

makeChange :: Int -> [Int] -> Int
makeChange n ys = go n (sort ys)
    where go _ [] = 0
          go n (x:xs)
            | x == n = 1
            | x > n = 0
            | otherwise = (makeChange n xs) + (makeChange (n - x) (x:xs))

However it times out on some of the larger test cases. I saw this article on implementing memoization using let bindings but it mostly went over my head and I'm not sure how I would implement that here. Any help?

I rewrote it and got a substantial performance improvement, but i'm still timing out on the hacker rank exercise:

makeChange' :: Int -> [Int] -> Int
makeChange' =
    let go _ [] = 0
        go n (x:xs)
          | x == n = 1
          | x > n = 0
          | otherwise = (makeChange' n xs) + (makeChange' (n - x) (x:xs))
    in go

f (x:y:xs) = makeChange' x ys
    where ys = sort xs
main = interact $ show . f . map read . words

I moved the pre-sort into an intermediate function f which I am also using to handle the input from Hacker Rank. They give you a string with the change target, the length of the change array, and the array of change units. I use f to drop the length from the input.

like image 974
Solomon Bothwell Avatar asked Jan 02 '23 09:01

Solomon Bothwell


2 Answers

This problem does not need memoization. If a is an infinite length list where a !! n is the total number of ways to make a total sum of n with some set of coins, and you get a new distinct coin of value x, you can update the list a to the new list b using the facts that:

  • The first x elements will not change; because, you cannot use the new coin for a sum less than x. so, take x a.
  • For the remaining elements:

    b(n) = a(n) + b(n - x)
    

    where the first summand means do not use the new coin at all, and the 2nd summand means use it at least once.

This can be simply implemented using a right fold, with initial value [1, 0, 0, ...], because with no coins the only sum you may make is zero. Haskell laziness is also very useful here:

solve :: Int -> [Int] -> Int
solve n xs = (foldr go (1:repeat 0) xs) !! n
  where go x a = let b = (take x a) ++ zipWith (+) b (drop x a) in b

then:

\> solve 4 [1, 2, 3]
4
\> solve 10 [2, 5, 3, 6]
5

as in the examples in the question.

like image 68
behzad.nouri Avatar answered Jan 12 '23 20:01

behzad.nouri


I think this is best solved with an explicit 2D array. In effect, we give the result of each function call a location in this array. This allows us to only need to evaluate function at most once. There's a tiny bit more boilerplate we have to add, because we need to check if we'd index outside the array

makeChange :: Int -> [Int] -> Int
makeChange n ys = arr ! (n,1)
    where 
      len = length xs
      xs = sort ys
      arr = array ((1,1),(n,len)) [((i,j), go i j x)| i <- [1..n], (j,x) <- zip [1..] xs]
      go n ix x | x == n = 1
                | x > n = 0
                | otherwise = (if ix + 1 <= len then (arr ! (n, ix+1)) else 0) + 
                              (if (n-x) > 0 then (arr ! ((n-x), ix)) else 0)
like image 29
Probie Avatar answered Jan 12 '23 20:01

Probie