Haskell：查找總計為給定數字的列表子集

Question

我正在研究一些示例，並嘗試實現一個功能，該功能計算列表中有多少個子集加起來達到一個給定的數字。

在嘗試將python中的一些實現重寫為Haskell時：

test1 :: [Int]
test1 = [2,4,6,10,1,4,5,6,7,8]

countSets1 total input = length [n | n <- subsets $ sort input, sum n == total]
  where
    subsets []  = [[]]
    subsets (x:xs) = map (x:) (subsets xs) ++ subsets xs


countSets2 total input = go (reverse . sort $ input) total
  where
    go [] _ = 0
    go (x:xs) t
      | t == 0 = 1
      | t < 0  = 0
      | t < x  = go xs t
      | otherwise  = go xs (t - x) + go xs t


countSets3 total input = go (sort input) total (length input - 1)
  where
  go xxs t i
    | t == 0         = 1
    | t < 0          = 0
    | i < 0          = 0
    | t < (xxs !! i) = go xxs t (i-1)
    | otherwise      = go xxs (t - (xxs !! i)) (i-1) + go xxs t (i-1)

我不知道為什么countSets2不能返回與countSets3相同的結果（python版本的副本）

λ: countSets1 16 test1
24
λ: countSets2 16 test1
13
λ: countSets3 16 test1
24

編輯：@freestyle指出我的條件的順序在兩種解決方案中是不同的：

countSets2 total input = go (sortBy (flip compare) input) total
  where
    go _  0 = 1
    go [] _ = 0
    go (x:xs) t
      | t < 0  = 0
      | t < x  = go xs t
      | otherwise  = go xs (t - x) + go xs t

解決問題。

Answer 1

我不確定您的邏輯，但是在第二種解決方案中，我認為您需要

go [] 0 = 1

否則，您的代碼將導致go [] 0 = 0 ，這是錯誤的。

Answer 2

我不會處理您的錯誤，所以我不希望您接受我的回答。 我只提供一個解決方案：

import           Math.Combinat.Sets (sublists)

getSublists :: [Int] -> Int -> [[Int]]
getSublists list total = filter (\x -> sum x == total) (sublists list)

countSublists :: [Int] -> Int -> Int
countSublists list total = length $ getSublists list total

Math.Combinat.Sets模塊來自combinat包。

>>> countSublists [2,4,6,10,1,4,5,6,7,8] 16
24

Answer 3

這個問題看起來與理查德·伯德（Richard Bird）所寫的關於多少個總和和乘積可以產生100 的珍珠類似。在這里，我將其用作模板。 一，規格：

subseqn :: (Num a, Eq a) => a -> [a] -> Int
subseqn n = length . filter ((== n) . sum) . subseqs

哪里

subseqs = foldr prefix [[]]
prefix x xss = map (x:) xss ++ xss

請注意， subseqs可能浪費很多工作。 直觀地，我們可以在候選數超過n時立即將其丟棄，即在某個位置使用弱謂詞(<= n) 。 瑣碎的是，先過濾它，再過濾更強的一個，不會改變結果。 然后你可以得出

filter ((== n) . sum) . subseqs
= {- insert weaker predicate -}
filter ((== n) . sum) . filter ((<= n) . sum) . subseqs
= {- definition of subseqs -}
filter ((== n) . sum) . filter ((<= n) . sum) . foldr prefix [[]]
= {- fusion law of foldr -}
filter ((== n) . sum) . foldr prefix' [[]]

融合定律指出f . foldr ga = foldr hb f . foldr ga = foldr hb iff

• f是嚴格的
• fa = b
• f（gxy）= hx（fy）

在這里，a = b = [[]] ，f是filter ((<= n) . sum) ，g是prefix 。 您可以通過觀察謂詞可以在添加前綴之前應用h（即prefix' ）來得出：

filter ((<= n) . sum) (prefix x xss) = 
  filter ((<= n) . sum) (prefix x (filter ((<= n) . sum) xss))

這正是第三個條件； 那么h是filter ((<= n) . sum) . prefix filter ((<= n) . sum) . prefix 。

另一個觀察結果是sum被計算了太多次。 為了解決這個問題，我們可以修改subseqn的定義，以便每個候選項都攜帶自己的和。 讓我們用

(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
(&&&) f g x = (f x, g x)

並得出

filter ((== n) . sum) . subseqs
= {- use &&& -}
filter ((== n) . snd) . map (id &&& sum) . subseqs
= {- definition of subseqs -}
filter ((== n) . snd) . map (id &&& sum) . foldr prefix' [[]]
= {- fusion law of foldr -}
filter ((== n) . snd) . foldr prefix'' [[]]

我不會遍歷prefix''的整個過程prefix'' ，這很長。 要點是，您可以通過成對工作來完全避免使用sum ，這樣就可以迭代地計算出sum。 最初，空列表的總和為0，我們要做的就是向其中添加新的候選項。

我們將基本情況從[[]]為[([], 0)]並得到：

prefix'' x = filter ((<= n) . snd) . uncurry zip . (prefix x *** add x) . unzip

哪里

(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
(***) f g (x, y) = (f x, g y)
add :: Num a => a -> [a] -> [a]
add x xs = map (x+) xs ++ xs

這是最終版本：

subseqn :: (Num a, Ord a) => a -> [a] -> Int
subseqn n = length . filter ((== n) . snd) . foldr expand [([], 0)]
  where
  expand x = filter ((<= n) . snd) . uncurry zip . (prefix x *** add x) . unzip
  prefix x xss = map (x:) xss ++ xss
  add x xs = map (x+) xs ++ xs

（ ***和&&&來自Control.Arrow）