在Haskell中使用递归方案来解决变更问题



我正试图从这个关于递归方案的博客中理解历史形态。当我运行示例来解决博客中提到的更改问题时,我遇到了一个问题。

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

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

这是…不正确的,因为你可以用一枚价值10的硬币制造10。

所以我认为这可能是在解决硬币兑换问题,它找到了你可以赚到给定金额的最大方法。例如,您可以用{ 1, 1, ... 10 times }{ 1, 1, 1, 1, 5}{ 5, 5 }{ 10 }以4种方式制作10。

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

TLDR

上面这篇关于递归方案的博客中的代码并没有找到改变一笔钱的最小或最大方法。为什么它不起作用?

我在用递归方案编码这个问题时花了更多的心思。也许有一种很好的方法可以解决无序问题(即,考虑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(使用适当的可折叠实例),但这是不正确的。我们不是在总结子问题中的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

最初与博客文章的混淆是因为它指向维基百科链接中的另一个问题。

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

完整的解决方案由@howsiwei在本期中描述。

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

它可以使用histomorphism来解决,但缓存和函子类型需要更复杂才能容纳更多的状态。即

  • 缓存需要保留一个特定金额的允许面额列表,这将使我们能够消除重叠
  • 更困难的挑战是找到一个可以对所有信息排序的函子。CCD_ 17将是不够的,因为它不能区分复杂缓存类型的不同值

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

我可以解决的问题是,它在缓存中查找了错误的值。当given = 10时,当然是validCoins = [10,5,1],所以我们找到了(zeroes, toProcess) = ([0], [5,9])。到目前为止,一切都很好:我们可以直接给一角硬币,也可以给五美分硬币,然后换剩下的五美分,或者我们可以给一美分硬币,换剩下的九美分。但当我们写lookup 9 attr时,我们说的是";查找历史中的9个步骤以确定何时CCD_ 22〃;,我们的意思是";当CCD_ 23〃时,在历史中查找1步;。因此,我们在几乎所有情况下都大大低估了:即使是change 100也只有16,而谷歌搜索声称正确的结果是292(我今天还没有通过自己实现来验证这一点)。

有一些等效的方法可以解决这个问题;最小的差异将取代

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

带有

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

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

如果不进行大量的算法返工,我看不出有什么方法可以解决这个问题。这个问题的传统动态编程解决方案包括按特定顺序生成解决方案,这样就可以避免重复计算。即,他们首先决定使用多少个一角硬币(此处为0或1),然后计算如何在不使用任何一角硬币的情况下更改剩余金额。我不知道如何在这里实现这个想法——你的缓存密钥需要更大,包括目标数量和允许的硬币集。

最新更新