5

我试图从这个关于递归方案的博客中理解组织同态。当我运行示例以解决博客中提到的变更问题时,我遇到了一个问题。

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

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

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

那么这段代码有什么问题呢?解决问题的问题在哪里?

TLDR

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

4

3 回答 3

4

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

我使用的工具是hylomorphism,稍后会在您正在阅读的文章系列中出现。它由折叠(变形)组成展开(变形)。hylomorphism 使用 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不查看这些值,因为它们不是 type 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
于 2021-10-20T18:05:13.780 回答
2

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

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

回到问题,主要问题在于lookup方法的实现。需要注意的关键点lookup是向后计算,即计算一个面额对总和的贡献,它应该作为参数传递给 the 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在本期中描述了完整的解决方案。

编辑:基于评论中的讨论,这可以使用组织态来解决,但有一些挑战

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

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

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

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

有几种等效的方法可以解决此问题;最小的差异是替换

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

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

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

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

于 2021-10-20T12:38:03.303 回答