在 Haskell 中使用递归方案解决找零问题

Using recursion schemes in Haskell for solving change making problem

我正在尝试从博客中提到的 blog on recursion schemes. I'm facing a problem when I'm running the example to solve the change making problem 理解组织态。

找零问题采用一种货币的面额,并试图找到创造给定金额所需的最少硬币数量。下面的代码取自博客,应该计算答案。

{-# 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

现在,如果你计算 change 10,它会给你 3。

这是...不正确的,因为您可以使用 1 枚价值 10 的硬币来制作 10。

所以我认为它可能正在解决 coin change problem,它会找到您可以赚取给定金额的最大方式数。例如你可以通过 { 1, 1, ... 10 times }{ 1, 1, 1, 1, 5}{ 5, 5 }{ 10 }.

的 4 种方式制作 10

那么这段代码有什么问题呢?解决问题哪里出错了?

TLDR

上面这段来自 blog on recursion schemes 的代码没有找到最小或最大的方法来改变一笔钱。为什么它不起作用?

我发现这个程序有两个问题。其中一个我知道如何修复,但另一个显然需要比我更多的递归方案知识。

我可以解决的问题是它在缓存中查找了错误的值。当given = 10时,当然是validCoins = [10,5,1],所以我们找到(zeroes, toProcess) = ([0], [5,9])。到目前为止一切顺利:我们可以直接给一毛钱,或者给一个镍币然后找零剩下的五美分,或者我们可以给一分钱然后找零剩下的九美分。但是当我们写 lookup 9 attr 时,我们说的是“在 curr = 1 时查看 9 步历史”,我们的意思是“在 curr = 9 时查看 1 步历史”。结果,我们在几乎所有情况下都大大低估了:甚至 change 100 也只有 16,而 Google 搜索声称正确的结果是 292(我今天还没有通过自己实施来验证这一点)。

有一些等效的方法可以解决这个问题;最小的差异是替换

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

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

第二个问题是:缓存中的值不对。正如我在对该问题的评论中提到的那样,这将相同面额的不同排序视为对问题的单独回答。在我修复第一个问题后,第二个问题出现的最低输入是 7,结果不正确 change 7 = 3。如果你尝试 change 100 我不知道计算需要多长时间:比它应该的要长得多,可能是很长的时间。但即使是像 change 30 这样的适度值也会产生比应有的大得多的数字。

如果不对算法进行大量返工,我看不到解决此问题的方法。此问题的传统动态规划解决方案涉及按特定顺序生成解决方案,因此您可以避免重复计算。也就是说,他们首先决定要使用多少角硬币(这里是 0 或 1),然后计算如何在不使用任何角硬币的情况下找零钱。我不知道如何在这里实现这个想法 - 你的缓存键需要更大,包括目标数量和允许的硬币组。

最初对博客 post 的混淆是因为它指向维基百科中的另一个问题 link。

重新查看 change,它试图找到对给定值进行更改的“有序”方式的数量。这意味着硬币的顺序很重要。 change 10的正确值应该是9。

回到问题上来,主要问题是 lookup 方法的实现。要注意的关键点是 lookup 是倒退的,即计算面额对总和的贡献,它应该作为参数传递给 lookup 而不是它与 given 值的区别.

--  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

issue by @howsiwei 中描述了完整的解决方案。

编辑:根据评论中的讨论,这可以使用 histomorphisms 解决,但有一些挑战

它可以使用 histomorphisms 来解决,但是缓存和仿函数类型需要更复杂才能保存更多状态。即-

  • 缓存需要保留特定数量的允许面额列表,这将使我们能够消除重叠
  • 更难的挑战是想出一个可以对所有信息进行排序的仿函数。 Nat 是不够的,因为它无法区分复杂缓存类型的不同值。

我更多地考虑用递归方案来编码这个问题。也许有一个很好的方法来解决无序问题(即考虑 5c + 1c 不同于 1c + 5c),使用组织态来缓存无向递归调用,但我不知道它是什么。相反,我寻找一种使用递归方案来实现动态编程算法的方法,其中以特定顺序探测搜索树,这样您就可以确保您不会多次访问任何节点。

我使用的工具是同质同构,它稍后会出现在您正在阅读的系列文章中。它由展开(变形)和折叠(变形)组成。同态使用 ana 构建中间结构,然后 cata 将其分解为最终结果。在这种情况下,我使用的中间结构描述了一个子问题。它有两个构造函数:要么子问题已经解决,要么还有一些钱要找零,以及要使用的硬币面额池:

data ChangePuzzle a = Solved Int
                    | Pending {spend, forget :: a}
                    deriving Functor
type Cent = Int
type ChangePuzzleArgs = ([Cent], Cent)

我们需要一个可以将单个问题转化为子问题的余数:

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

我最初尝试编写 conquer = sum(使用适当的 Foldable 实例),但这是不正确的。我们没有总结子问题中的 a 类型;相反,所有有趣的值都在 Solved 构造函数的 Int 字段中,并且 sum 不查看这些值,因为它们不是 a.

类型

最后,我们让递归方案通过简单的 hylo 调用为我们完成实际的递归:

waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide

我们可以确认它在 GHCI 中有效:

*Main> waysToMakeChange (coins, 10)
4
*Main> waysToMakeChange (coins, 100)
292

您是否认为这值得付出努力取决于您。递归方案在这里为我们节省了很少的工作,因为这个问题很容易手工解决。但是您可能会发现具体化中间状态会使递归结构显式,而不是在调用图中隐式。不管怎样,如果你想练习递归方案来为更复杂的任务做准备,这是一个有趣的练习。

为方便起见,下面包含完整的工作文件。

{-# 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