我試圖從這個關于遞回方案的博客中理解組織同態。我在運行示例以解決博客中提到的更改問題時遇到了問題。

找零問題采用貨幣的面額，并試圖找到創造給定金額所需的最少硬幣數量。下面的代碼取自博客，應該計算答案。

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

上面這篇關于遞回方案的博客的代碼沒有找到改變一筆錢的最小或最大方法。為什么它不起作用？

uj5u.com熱心網友回復：

最初與博客文章的混淆是因為它指向維基百科鏈接中的另一個問題。

重新審視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。

編輯：基于評論中的討論，這可以使用 histomorphisms 解決，但有一些挑戰

它可以使用組織同態來解決，但快取和函子型別需要更復雜才能保存更多狀態。即——

• 快取將需要保留特定金額的允許面額串列，這將允許我們消除重疊
• 更難的挑戰是想出一個可以對所有資訊進行排序的函子。Nat這還不夠，因為它無法區分復雜快取型別的不同值。

uj5u.com熱心網友回復：

我看到這個程式有兩個問題。其中一個我知道如何修復，但另一個顯然需要比我更多的遞回方案知識。

我可以解決的問題是它在快取中查找錯誤的值。什么時候given = 10，當然validCoins = [10,5,1]等我們找到(zeroes, toProcess) = ([0], [5,9])。到目前為止一切都很好：我們可以直接給一角錢，或者給五分錢然后再換剩下的五分錢，或者我們可以給一分錢換剩下的九分錢。但是當我們寫的時候lookup 9 attr，我們說“從歷史上看 9 步到curr = 1什么時候”，我們的意思是“從歷史中看 1 步到什么時候curr = 9”。因此，我們幾乎在所有情況下都大大低估了：即使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），然后計算如何在不使用任何一角硬幣的情況下對剩余金額進行更改。我不知道如何在這里實作這個想法 - 您的快取密鑰需要更大，包括目標數量和允許的一組硬幣。

uj5u.com熱心網友回復：

我更多地考慮用遞回方案編碼這個問題。也許有一個很好的方法來解決無序問題（即，考慮到 5c 1c 與 1c 5c 不同）使用組織同態來快取無向遞回呼叫，但我不知道它是什么。相反，我尋找了一種使用遞回方案來實作動態編程演算法的方法，其中以特定順序探測搜索樹，以便您確定不會多次訪問任何節點。

我使用的工具是 hylomorphism，它會出現在您正在閱讀的系列文章的稍后部分。它由折疊（變形）組成一個展開（變形）。hylomorphism 使用 ana 來構建中間結構，然后 cata 將其分解為最終結果。在這種情況下，我使用的中間結構描述了一個子問題。它有兩個建構式：或者子問題已經解決，或者還有一些錢可以改變，還有一個硬幣面額可以使用：

data ChangePuzzle a = Solved Cent
                    | 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 Cent
conquer (Solved n) = n
conquer (Pending a b) = a   b

我最初嘗試撰寫conquer = sum（使用適當的可折疊實體），但這是不正確的。我們不是在總結a子問題中的型別；相反，所有有趣的值都在 Solved 建構式的 Cent 欄位中，并且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 Cent
                    | 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 Cent
conquer (Solved n) = n
conquer (Pending a b) = a   b

waysToMakeChange :: ChangePuzzleArgs -> Int
waysToMakeChange = hylo conquer divide

標籤：算法 哈斯克尔 递归 动态规划

上一篇：實作圖操作演算法

下一篇：生成圖邊的高效演算法