Memoizing Recursive Function in Haskell-CodePudding

I have a haskell function that attempts to solve this problem:

Write a function 'howSum(targetSum, numbers)' that takes in a targetSum and an array of numbers as arguments. The function should return an array containing any combination of elements that add up to exactly the targetSum. If there is no combination that adds up to the targetSum, then return null. If there are multiple combinations possible, you may return any single one.

What I have returns all possible combos of numbers.

The function works by creating a recursive tree where the first call has the total sum, target, and concatMap creates a branch for each number with the remaining sum needed. If this reaches a target of 0, the branch to get there was a combination of subtracting numbers from nums, meaning you can use numbers in the nums to sum to target. When returned the result with the value at that node is concatenated (to each sub-list).

From my testing the function works properly, but the memoization does not. I know now that the memo (Map object) is useless in my attempt, because it is immutable and separate calls to howSumMemo only get access to cashed values that are ancestors in the recursive tree. It would work if memo was a mutable and referenced (Which is not possible in Haskell).

import Data.Map (Map, member, findWithDefault, empty, insert)
howSumMemo :: Int -> [Int] -> Map Int [[Int]] -> [[Int]]
howSumMemo target nums memo
    | target > 0 = findWithDefault val target $ insert target val memo
    | target < 0 = []
    | otherwise = [[]]
    where val = concatMap (\x -> map (x :) (howSumMemo (target-x) nums memo)) nums

-- Memoized howSum
howSum target nums = howSumMemo target nums empty


-- Normal howSum
howSum' :: Int -> [Int] -> [[Int]]
howSum' target nums
    | target > 0 = concatMap (\x -> map (x :) (howSum' (target-x) nums)) nums
    | target < 0 = []
    | otherwise = [[]]

How can I get the memoization to work for howSum? I've tried referencing https://wiki.haskell.org/Memoization.

CodePudding user response：

When all else fails when trying to implement something stateful in a functional way, you can always use the State monad. Here is a version using Control.Monad.Trans.State.Strict from transformers:

howSumState :: Int -> [Int] -> State (Map Int [[Int]]) [[Int]]
howSumState target nums
    | target > 0 = join <$> traverse (\x -> fmap (x :) <$> recurse (target - x)) nums
    | target < 0 = return []
    | otherwise = return [[]]
    where recurse x = do
            m <- gets $ Map.lookup x
            case m of
              Just res -> return res
              Nothing -> do
                res <- howSumState x nums
                modify (Map.insert x res)
                return res

The memoisation data structure is still a map. The recurse function does most of the heavy lifting.

It first attempts to lookup the result in the map. The result of a Map.lookup is a Maybe value. If it's a Just value, it means that the result is already in the map, so just return it.

If the lookup returns a Nothing value, call howSumState in order to produce the result, insert it into the map, and return it.

You can create a memoised howSum function by evaluating the State value:

-- Memoized howSum
howSum :: Int -> [Int] -> [[Int]]
howSum target nums = evalState (howSumState target nums) Map.empty

evalState only returns the final value. If you also want to se the state that was built up, you can use runState:

ghci> runState (howSumState 3 [1,2]) Map.empty
([[1,1,1],[1,2],[2,1]],fromList [(-1,[]),(0,[[]]),(1,[[1]]),(2,[[1,1],[2]])])

The first element of the tuple is the result:

[[1,1,1],[1,2],[2,1]]

The second element of the tuple is the map, here formatted for readability:

Map.fromList [
    (-1, []),
    (0, [[]]),
    (1, [[1]]),
    (2, [[1,1],[2]])]

Each value is a tuple where the first element is the key and the second the value.

Since we also have the non-memoised howSum' function we can use it as a test oracle. I wrote a QuickCheck-based property to verify that both implementations return the same values:

testProperty "Both implementations behave the same" (withMaxSuccess 10000 (do
    target <- resize 10 arbitrary
    nums <- fmap getPositive <$> arbitrary

    let actual = howSum target nums

    let expected = howSum' target nums
    return $ expected === actual))

This property runs 10,000 tests, which all pass.