在Haskell中快速获取所有大小为N的子集

Question

以下（不太优化的）代码生成了某个子集大小为N的所有子集。

这段代码虽然可用，但是如我所说，非常不优化。使用中间列表来避免Set.insert的O(log(n))似乎没有帮助，因为后面将列表重新转换为Set的成本很大。

有人能建议如何优化代码吗？

import qualified Data.Set as Set


subsetsOfSizeN :: Ord a => Int -> Set.Set a -> Set.Set (Set.Set a)
subsetsOfSizeN n s
  | Set.size s < n || n < 0 = error "subsetOfSizeN: wrong parameters"
  | otherwise = doSubsetsOfSizeN n s
 where doSubsetsOfSizeN n s
        | n == 0 = Set.singleton Set.empty
        | Set.size s == n = Set.singleton s
        | otherwise =
           case Set.minView s of
             Nothing -> Set.empty
             Just (firstS, restS) ->
               let partialN n = doSubsetsOfSizeN n restS in
               Set.map (Set.insert firstS) (partialN (n-1)) `Set.union` partialN n

- fons

Answer 1

这是受到帕斯卡三角形的启发。

choose :: [b] -> Int -> [[b]]
_      `choose` 0       = [[]]
[]     `choose` _       =  []
(x:xs) `choose` k       =  (x:) `fmap` (xs `choose` (k-1)) ++ xs `choose` k

- rickythesk8r

---

非常好，我喜欢这个。 - zurgl

非常优雅，恭喜 :) - miniBill

Answer 2

这段代码可以工作，但是，正如我所说的，非常不优化。 在我看来并不是那么糟糕。大小为n的集合中大小为k的子集的数量是n个选择k，当k~n/2时增长相当快。因此创建所有子集必须缩小规模。 使用一个中间列表来避免Set.insert的O(log(n))似乎没有帮助，因为后面重新将列表转换为Set的代价很大。 嗯，我发现使用列表可以提供更好的性能。我认为在渐近意义下不是这样，但是有一个不可忽略的更或多或少的常数因子。 但首先，你的代码中存在一些低效之处，这很容易修复：

Set.map (Set.insert firstS) (partialN (n-1))

请注意，Set.map必须从头开始重建一棵树。但我们知道firstS始终小于任何一个partialN（n-1）集合中的元素，因此我们可以使用Set.mapMonotonic来重复使用集合的脊柱。

这个原则也是使列表具有吸引力的原因，子集按字典顺序生成，因此我们可以使用更高效的Set.fromDistinctAscList代替Set.fromList。算法转录如下：

onlyLists :: Ord a => Int -> Set.Set a -> Set.Set (Set.Set a)
onlyLists n s
    | n == 0                    = Set.singleton Set.empty
    | Set.size s < n || n < 0   = error "onlyLists: out of range n"
    | Set.size s == n           = Set.singleton s
    | otherwise                 = Set.fromDistinctAscList . map Set.fromDistinctAscList $
                                                         go n (Set.size s) (Set.toList s)
      where
        go 1 _ xs = map return xs
        go k l (x:xs)
            | k == l = [x:xs]
            | otherwise = map (x:) (go (k-1) (l-1) xs) ++ go k (l-1) xs

在我运行的少数基准测试中，使用Set的修改算法比原算法快1.5到2倍。

而根据我的标准基准测试，这个算法又比dave4420的算法快近两倍。

- Daniel Fischer

Answer 3

subsets :: Int -> [a] -> [[a]]
subsets 0 _ = [[]]
subsets _ [] = []
subsets k (x:xs) = map (x:) (subsets (k - 1) xs) ++ subsets k xs

- schickling

Answer 4

首先，使用更好的算法。

看看你的最后一行：

           Set.map (Set.insert firstS) (partialN (n-1)) `Set.union` partialN n

评估doSubsetsOfSizeN k (Set.fromList $ 1:2:xs)将涉及评估doSubsetsOfSizeN (k-1) (Set.fromList xs)两次（一次在插入1时，一次在插入2时）。这种重复是浪费的。

输入更好的算法。

mine :: Ord a => Int -> Set.Set a -> Set.Set (Set.Set a)
mine n s | Set.size s < n || n < 0 = Set.empty
         | otherwise               = Set.foldr cons nil s !! n
    where
        nil :: Ord a => [Set.Set (Set.Set a)]
        nil = Set.singleton Set.empty : repeat Set.empty
        cons :: Ord a => a -> [Set.Set (Set.Set a)] -> [Set.Set (Set.Set a)]
        cons x sets = zipWith Set.union sets
                               (Set.empty : map (Set.map $ Set.insert x) sets)

mine 9 (Data.Set.fromList [0..18]) `seq` ()比subsetsOfSizeN 9 (Data.Set.fromList [0..18]) `seq` ()更快，而且应该具有更好的渐近性能。

我还没有尝试进一步优化。可能仍然有更好的算法。

（如果insert和fromList的成本是问题，您应该考虑返回一个列表而不是一组集合。）

- dave4420

Answer 5

我找到了这个，也许可以帮助你

f []  = [[1]]
f l   = (:) [u] l'
    where 
        u  = succ (head (head l))
        l' = (++) l (map(\x->(:) u x) l)

fix f n = if (n==0) then [] else f (fix f (n-1)) 

为了测试它

$ length $ (fix f 10) => 1023 -- The empty set is always include then == 1024

- zurgl

---

有没有特别的原因使用 (:) [u] l' 而不是仅仅使用 [u]:l'？（以及在 l' 的定义中类似地使用 (++) 和 (:)。） - huon

是的，我更喜欢使用这种形式，因为我可以在我的where子句中编写cons = uncurry(:)，concat = uncurry(++)，并将[u]:l'替换为cons [u] l。 - zurgl