在 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
我正在尝试从博客中提到的 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 }.
那么这段代码有什么问题呢？解决问题哪里出错了？
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