利用Haskell中的递归方案解决变化制造问题 [英] Using recursion schemes in Haskell for solving change making problem

问题描述

我正试图从blog on recursion schemes中理解组织同构。我在运行博客中提到的解决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。

这是..。不正确，因为您可以用一枚值为10的硬币赚10。

所以我考虑它可能是求解coin change problem，它找出了你可以赚到给定金额的最大数量的方法。例如，您可以使用{ 1, 1, ... 10 times }、{ 1, 1, 1, 1, 5}、{ 5, 5 }、{ 10 }四种方式制作10。

那么这段代码出了什么问题呢？在解决问题的过程中出了什么问题？

TLDR

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

推荐答案

我在用递归方案编码这个问题上花了更多的心思。也许有一个很好的方法来解决无序问题(即，认为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类型；相反，所有有趣的值都在已解决构造函数的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

这篇关于利用Haskell中的递归方案解决变化制造问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！