在 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