hello, i have been very much enjoying the process of learning haskell, and i have a question about a ‘coding challenge’-type problem i started. it is a variation on the purse problem: find the smallest collection of coins that sums to a given value, given standard denominations. the problem resolves to tracing a combinatorial graph, but pruning and memoization make it tractable. unsurprisingly the brute force solution can be written in a few lines of haskell, but i am having trouble implementing the optimizations. to help, i wrote a solution in python:
import copy
from typing import List, Set, Tuple
def get_purses(purse: List[int],
value: int,
min_len: int=1e10,
path: List[int]=None,
visited: Set[int]=None) -> Tuple[int, List[List[int]]]:
"""
:param purse: the available denominations, eg [1, 5, 10, 25] for american currency.
:param value: the target value.
:param min_len: the smallest collection thus found.
:param path: the current collection going down a branch.
:param visited: all values that have thus far been calculated.
"""
# coins must be used greedily
purse = sorted(purse)[::-1]
if path is None:
path = []
if visited is None:
visited = set()
if value == 0:
min_len = min(min_len, len(path))
return (min_len, [copy.copy(path)])
elif len(path) >= min_len or value in visited:
return (min_len, [])
visited.add(value)
all_paths = []
for p in filter(lambda x: value - x >= 0, purse):
path.append(p)
(min_len, new_path) = get_purses(purse, value - p, min_len, path, visited)
all_paths.extend(new_path)
path.pop()
return (min_len, all_paths)
it works perfectly fine, so as a first pass i tried to implement those same optimizations into haskell, but something doesn’t work! that is, the code compiles and finds the correct answer, but much more slowly, implying that i am doing something wrong.
import Data.List (sort)
import Data.Set (Set, insert, fromList)
composeFunctions :: [(a -> a)] -> (a -> a)
composeFunctions funcs = foldl (\f0 -> \f1 -> (f0 . f1)) (\x -> x) funcs
getPursesExpanded :: [Integer] -> Integer -> Integer -> [Integer] -> Set Integer -> (Integer, [[Integer]])
getPursesExpanded purse value min_len path visited
| value == 0 = (min min_len (toInteger $ length path), [path])
| (toInteger $ length path) >= min_len || elem value visited = (min_len, [])
| otherwise = (min_min, all_paths)
where new_visited = insert value visited
limited_purse = filter (\x -> value - x >=0) purse
functions_to = map (\x -> \(new_min, _) -> getPursesExpanded purse (value - x) new_min (x:path) new_visited) limited_purse
composed_fs = [composeFunctions (reverse $ take n functions_to) | n <- [1..(length limited_purse)]]
applied_fs = [f (min_len, []) | f <- composed_fs]
min_min = minimum [fst x | x <- applied_fs]
all_paths = foldl (\x -> \y -> (x ++ (snd y))) [] applied_fs
findFirstOfLength :: (Integer, [[Integer]]) -> [Integer]
findFirstOfLength (min_len, (x:xs))
| (toInteger $ length x) == min_len = x
| otherwise = findFirstOfLength (min_len, xs)
getPurse :: [Integer] -> Integer -> [Integer]
getPurse purse value = findFirstOfLength $ getPursesExpanded (reverse $ sort purse) value (10^10 :: Integer) [] (fromList [])
one problem i had, generally, was trying to update the minimum length path so i could pass the most recent version into subsequent searches. i tried to do this by function composition… which seems crazy… but it worked. i know there is the State monad, and i was going to use this opportunity to learn that after i resolved this.
thank you!