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?

TLDR

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?

CodePudding user response：

The initial confusion with the blog post was because it was pointing to a different problem in the wikipedia link.

Retaking a look at change, it's trying to find the number of "ordered" ways of making change for a given value. This means that the ordering of coins matters. The correct value of change 10 should be 9.

Coming back to the problem, the main issue is with the implementation of the lookup method. The key point to note is that lookup is backwards i.e to calculate the contribution of a denomination to the sum it should be passed as argument to the lookup and not it's difference with the given value.

--  to find contribution of 5 to the number of ways we can
--  change 15. We should pass the cache of 15 and 5 as the
--  parameters. So the cache will be unrolled 5 times to 
--  to get the value from cache of 10
lookup :: Attr Nat a  -- ^ cache
       -> Int         -- ^ how much to roll back
       -> a
lookup cache 1 = attribute cache
lookup cache n = lookup inner (n - 1) where (Next inner) = hole cache

The complete solution is described in this issue by @howsiwei.

And finally the problem of counting the unordered number of ways to change a given value, canNOT be solved by histomorphisms, as far as I understand. The reason is that unordered counting requires maintaining additional state or performing the recursion in a specific order, this is not supported by histomorphisms as described in the blog.

CodePudding user response：

I see two problems with this program. One of them I know how to fix, but the other apparently requires more knowledge of recursion schemes than I have.

The one I can fix is that it's looking up the wrong values in its cache. When given = 10, of course validCoins = [10,5,1], and so we find (zeroes, toProcess) = ([0], [5,9]). So far so good: we can give a dime directly, or give a nickel and then make change for the remaining five cents, or we can give a penny and change the remaining nine cents. But then when we write lookup 9 attr, we're saying "look 9 steps in history to when curr = 1", where what we meant was "look 1 step into history to when curr = 9". As a result we drastically undercount in pretty much all cases: even change 100 is only 16, while a Google search claims the right result is 292 (I haven't verified this today by implementing it myself).

There are a few equivalent ways to fix this; the smallest diff would be to replace

results = sum (map (lookup attr)) toProcess)

with

results = sum (map (lookup attr . (given -)) toProcess)

The second problem is: the values in the cache are wrong. As I mentioned in a comment on the question, this counts different orderings of the same denominations as separate answers to the question. After I fix the first problem, the lowest input where this second problem manifests is 7, with the incorrect result change 7 = 3. If you try change 100 I don't know how long it takes to compute: much longer than it should, probably a very long time. But even a modest value like change 30 yields a number that's much larger than it should be.

I don't see a way to fix this without a substantial algorithm rework. Traditional dynamic-programming solutions to this problem involve producing the solutions in a specific order so you can avoid double-counting. i.e., they first decide how many dimes to use (here, 0 or 1), then compute how to make change for the remaining amounts without using any dimes. I don't know how to work that idea in here - your cache key would need to be larger, including both the target amount and also the allowed set of coins.