I'm trying to understand histomorphisms from this blog on recursion schemes. I'm facing a problem when I'm running the example to solve the change making problem as mentioned in the blog.
Change making problem takes the denominations for a currency and tries to find the minimum number of coins required to create a given sum of money. The code below is taken from the blog and should compute the answer.
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Control.Arrow ( (>>>) )
import Data.List ( partition )
import Prelude hiding (lookup)
newtype Term f = In {out :: f (Term f)}
data Attr f a = Attr
{ attribute :: a
, hole :: f (Attr f a)
}
type CVAlgebra f a = f (Attr f a) -> a
histo :: Functor f => CVAlgebra f a -> Term f -> a
histo h = out >>> fmap worker >>> h
where
worker t = Attr (histo h t) (fmap worker (out t))
type Cent = Int
coins :: [Cent]
coins = [50, 25, 10, 5, 1]
data Nat a
= Zero
| Next a
deriving (Functor)
-- Convert from a natural number to its foldable equivalent, and vice versa.
expand :: Int -> Term Nat
expand 0 = In Zero
expand n = In (Next (expand (n - 1)))
compress :: Nat (Attr Nat a) -> Int
compress Zero = 0
compress (Next (Attr _ x)) = 1 + compress x
change :: Cent -> Int
change amt = histo go (expand amt)
where
go :: Nat (Attr Nat Int) -> Int
go Zero = 1
go curr@(Next attr) =
let given = compress curr
validCoins = filter (<= given) coins
remaining = map (given -) validCoins
(zeroes, toProcess) = partition (== 0) remaining
results = sum (map (lookup attr) toProcess)
in length zeroes + results
lookup :: Attr Nat a -> Int -> a
lookup cache 0 = attribute cache
lookup cache n = lookup inner (n - 1) where (Next inner) = hole cache
Now if you evaluate change 10 it will give you 3.
Which is... incorrect because you can make 10 using 1 coin of value 10.
So I considered maybe it's solving the coin change problem, which finds the maximum number of ways in which you can make the given sum of money. For e.g. you can make 10 in 4 ways with { 1, 1, ... 10 times }, { 1, 1, 1, 1, 5}, { 5, 5 }, { 10 }.
So what is wrong with this piece of code? Where is it going wrong in solving the problem?
The above piece of code from this blog on recursion schemes is not finding minimum or maximum ways to change a sum of money. Why is it not working?
I put some more thought into encoding this problem with recursion schemes. Maybe there's a good way to solve the unordered problem (i.e., considering 5c + 1c to be different from 1c + 5c) using a histomorphism to cache the undirected recursive calls, but I don't know what it is. Instead, I looked for a way to use recursion schemes to implement the dynamic-programming algorithm, where the search tree is probed in a specific order so that you're sure you never visit any node more than once.
The tool that I used is the hylomorphism, which comes up a bit later in the article series you're reading. It composes an unfold (anamorphism) with a fold (catamorphism). A hylomorphism uses ana to build up an intermediate structure, and then cata to tear it down into a final result. In this case, the intermediate structure I used describes a subproblem. It has two constructors: either the subproblem is solved already, or there is some amount of money left to make change for, and a pool of coin denominations to use:
data ChangePuzzle a = Solved Int
| Pending {spend, forget :: a}
deriving Functor
type Cent = Int
type ChangePuzzleArgs = ([Cent], Cent)
We need a coalgebra that turns a single problem into subproblems:
divide :: Coalgebra ChangePuzzle ChangePuzzleArgs
divide (_, 0) = Solved 1
divide ([], _) = Solved 0
divide (coins@(x:xs), n) | n < 0 = Solved 0
| otherwise = Pending (coins, n - x) (xs, n)
I hope the first three cases are obvious. The last case is the only one with multiple subproblems. We can either use one coin of the first listed denomination, and continue to make change for that smaller amount, or we can leave the amount the same but reduce the list of coin denominations we're willing to use.
The algebra for combining subproblem results is much simpler: we simply add them up.
conquer :: Algebra ChangePuzzle Int
conquer (Solved n) = n
conquer (Pending a b) = a + b
I originally tried to write conquer = sum (with the appropriate Foldable instance), but this is incorrect. We're not summing up the a types in the subproblem; rather, all the interesting values are in the Int field of the Solved constructor, and sum doesn't look at those because they're not of type a.
Finally, we let recursion schemes do the actual recursion for us with a simple hylo call:
waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide
And we can confirm it works in GHCI:
*Main> waysToMakeChange (coins, 10)
4
*Main> waysToMakeChange (coins, 100)
292
Whether you think this is worth the effort is up to you. Recursion schemes have saved us very little work here, as this problem is easy to solve by hand. But you may find reifying the intermediate states makes the recursive structure explicit, instead of implicit in the call graph. Anyway it's an interesting exercise if you want to practice recursion schemes in preparation for more complicated tasks.
The full, working file is included below for convenience.
{-# LANGUAGE DeriveFunctor #-}
import Control.Arrow ( (>>>), (<<<) )
newtype Term f = In {out :: f (Term f)}
type Algebra f a = f a -> a
type Coalgebra f a = a -> f a
cata :: (Functor f) => Algebra f a -> Term f -> a
cata fn = out >>> fmap (cata fn) >>> fn
ana :: (Functor f) => Coalgebra f a -> a -> Term f
ana f = In <<< fmap (ana f) <<< f
hylo :: Functor f => Algebra f b -> Coalgebra f a -> a -> b
hylo alg coalg = ana coalg >>> cata alg
data ChangePuzzle a = Solved Int
| Pending {spend, forget :: a}
deriving Functor
type Cent = Int
type ChangePuzzleArgs = ([Cent], Cent)
coins :: [Cent]
coins = [50, 25, 10, 5, 1]
divide :: Coalgebra ChangePuzzle ChangePuzzleArgs
divide (_, 0) = Solved 1
divide ([], _) = Solved 0
divide (coins@(x:xs), n) | n < 0 = Solved 0
| otherwise = Pending (coins, n - x) (xs, n)
conquer :: Algebra ChangePuzzle Int
conquer (Solved n) = n
conquer (Pending a b) = a + b
waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide