函数在Haskell中生成列表的唯一组合

xzlaal3s  于 2023-06-23  发布在  其他
关注(0)|答案(7)|浏览(145)

有没有Haskell函数可以从列表中生成给定长度的所有唯一组合?

Source = [1,2,3]

uniqueCombos 2 Source = [[1,2],[1,3],[2,3]]

我试着在Hoogle中寻找,但找不到一个功能,这样做了具体。置换不能给予期望的结果。
以前有人用过类似的功能吗?

i7uaboj4

i7uaboj41#

我也不知道一个预定义的函数,但自己写很容易:

-- Every set contains a unique empty subset.
subsets 0 _ = [[]]

-- Empty sets don't have any (non-empty) subsets.
subsets _ [] = []

-- Otherwise we're dealing with non-empty subsets of a non-empty set.
-- If the first element of the set is x, we can get subsets of size n by either:
--   - getting subsets of size n-1 of the remaining set xs and adding x to each of them
--     (those are all subsets containing x), or
--   - getting subsets of size n of the remaining set xs
--     (those are all subsets not containing x)
subsets n (x : xs) = map (x :) (subsets (n - 1) xs) ++ subsets n xs
brgchamk

brgchamk2#

使用Data.List

import Data.List
combinations k ns = filter ((k==).length) $ subsequences ns

参考:99 Haskell Problems
参考文献中有不少有趣的解决方案,我只是挑了一个简洁的。

p4rjhz4m

p4rjhz4m3#

我不清楚你对业绩有多关心。
如果它有任何用处的话,早在2014年,有人发布了某种performance contest的各种Haskell组合生成算法。
26项中的13项组合,执行时间从3秒到167秒不等!最快的入口是由Bergi提供的。下面是一个不明显的(至少对我来说)源代码:

subsequencesOfSize :: Int -> [a] -> [[a]]
subsequencesOfSize n xs = let l = length xs
                          in if (n > l) then []
                             else subsequencesBySize xs !! (l-n)
 where
   subsequencesBySize [] = [[[]]]
   subsequencesBySize (x:xs) = let next = subsequencesBySize xs
                               in zipWith (++)
                                    ([]:next)
                                    ( map (map (x:)) next ++ [[]] )

最近,在从一个大列表(100个中的5个)中挑选几个元素的特定上下文中,问题一直是revisited。在这种情况下,你不能使用像subsequences [1 .. 100]这样的东西,因为它引用的是一个长度为2100 1.26*1030的列表。我提交了一个基于algorithm的状态机,它并不像我所希望的那样具有Haskell的习惯性,但在这种情况下是相当有效的,每个输出项大约30个时钟周期。

旁注:使用 multisets 生成组合?

此外,还有一个Math.Combinatorics.Multiset包可用。这是documentation。我只是简单地测试了它,但它可以用来生成组合。
例如,8个元素中的3个元素的所有组合的集合就像具有两个元素(存在和不存在)的multiset的“排列”,这些元素各自具有3和(8-3)=5的多重性。
让我们使用这个想法来生成8个元素中3个元素的所有组合。有(876)/(321)= 336/6 = 56个。

*L M Mb T MS> import qualified Math.Combinatorics.Multiset as MS
*Math.Combinatorics.Multiset L M Mb T MS> pms = MS.permutations
*Math.Combinatorics.Multiset L M Mb T MS> :set prompt "λ> "
λ> 
λ> pms38 = pms $ MS.fromCounts [(True, 3), (False,5)]
λ> 
λ> length pms38
56
λ>
λ> take 3 pms38
[[True,True,True,False,False,False,False,False],[True,True,False,False,False,False,False,True],[True,True,False,False,False,False,True,False]]
λ> 
λ> str = "ABCDEFGH"
λ> combis38 = L.map fn pms38 where fn mask = L.map fst $ L.filter snd (zip str mask)
λ> 
λ> sort combis38
["ABC","ABD","ABE","ABF","ABG","ABH","ACD","ACE","ACF","ACG","ACH","ADE","ADF","ADG","ADH","AEF","AEG","AEH","AFG","AFH","AGH","BCD","BCE","BCF","BCG","BCH","BDE","BDF","BDG","BDH","BEF","BEG","BEH","BFG","BFH","BGH","CDE","CDF","CDG","CDH","CEF","CEG","CEH","CFG","CFH","CGH","DEF","DEG","DEH","DFG","DFH","DGH","EFG","EFH","EGH","FGH"]
λ>
λ> length combis38
56
λ>

因此,至少在功能上,使用多重集来生成组合的想法是可行的。

disbfnqx

disbfnqx4#

lib中没有这样的操作,但你可以自己轻松实现:

import Data.List

main = putStrLn $ show $ myOp 2 [1, 2, 3]

myOp :: Int -> [a] -> [[a]]
myOp 0 _ = []
myOp 1 l = map (:[]) l
myOp c l = concat $ map f $ tails l
    where
        f :: [a] -> [[a]]
        f []     = []
        f (x:xs) = map (x:) $ myOp (c - 1) xs
6rqinv9w

6rqinv9w5#

@melpomene的回答很一般,非常简洁。这可能是你在互联网上看到的许多地方需要combinationsOf函数的情况。
然而隐藏在双重递归的背后,它做了大量不必要的递归调用,这些调用是可以避免的,产生了一个非常高效的代码。也就是说,如果列表的长度短于k,我们不需要进行任何调用。
我建议双重终止检查。

combinationsOf :: Int -> [a] -> [[a]]
combinationsOf k xs = runner n k xs
                      where
                      n = length xs
                      runner :: Int -> Int -> [a] -> [[a]]
                      runner n' k' xs'@(y:ys) = if k' < n'      -- k' < length of the list
                                                then if k' == 1
                                                     then map pure xs'
                                                     else map (y:) (runner (n'-1) (k'-1) ys) ++ runner (n'-1) k' ys
                                                else pure xs'   -- k' == length of the list.

λ> length $ subsets 10 [0..19] -- taken from https://stackoverflow.com/a/52602906/4543207
184756
(1.32 secs, 615,926,240 bytes)

λ> length $ combinationsOf 10 [0..19]
184756
(0.45 secs, 326,960,528 bytes)

因此,上面的代码虽然尽可能优化,但仍然效率低下,主要是由于内部的双重递归。作为经验法则,在任何算法中,最好避免双重递归,或者在非常仔细的检查下加以考虑。
另一方面,下面的算法在速度和内存消耗两方面都是完成这项工作的非常有效的方法。

combinationsOf :: Int -> [a] -> [[a]]
combinationsOf k as@(x:xs) | k == 1    = map pure as
                           | k == l    = pure as
                           | k >  l    = []
                           | otherwise = run (l-1) (k-1) as $ combinationsOf (k-1) xs
                             where
                             l = length as

                             run :: Int -> Int -> [a] -> [[a]] -> [[a]]
                             run n k ys cs | n == k    = map (ys ++) cs
                                           | otherwise = map (q:) cs ++ run (n-1) k qs (drop dc cs)
                                           where
                                           (q:qs) = take (n-k+1) ys
                                           dc     = product [(n-k+1)..(n-1)] `div` product [1..(k-1)]

λ> length $ combinationsOf 10 [0..19]
184756
(0.09 secs, 51,126,448 bytes)
0h4hbjxa

0h4hbjxa6#

Monadic solution for unique combinations

cb _ 0 = [[]]
cb xs n = (nxs >>= (\(nx, x) -> (x:) <$> (cb [z | (n,z) <- nxs, n>nx] (n-1)) )) where nxs = zip [1..] xs
vom3gejh

vom3gejh7#

我也有同样的问题。我试着在标准库中寻找解决方案,但找不到。我想到了这个

genCombinations :: Int -> [a] -> [[a]]
genCombinations 0 _ = [[]]
genCombinations n xs =
  genCombinations' [] xs n
  where
    -- \| Generates new combinations by replacing elements in the old combinations (the accumulator)
    -- \| with the first element from the list.
    genCombinations' :: [[a]] -> [a] -> Int -> [[a]]
    genCombinations' acc [] _ = acc
    genCombinations' acc (x : xs) n =
      -- replace elements in lists from accumulator, and add a combination made of the first element
      let newCombinations = concatMap (replaceElems x) acc ++ [replicate n x]
       in newCombinations ++ genCombinations' (acc ++ newCombinations) xs n

    replaceElems :: a -> [a] -> [[a]]
    replaceElems x xs =
      replaceElems' x (length xs) 0 xs

    replaceElems' :: a -> Int -> Int -> [a] -> [[a]]
    replaceElems' _ _ _ [] = []
    -- count - how many elements were replaced before
    -- n - total length of the combination
    replaceElems' x n count [y]
      | count == n - 1 = [[y]] -- all prievous elements were replaced, don't replace now
      | count == 0 = [[x]] -- no elements were replaced, replace now
      | otherwise = [[x], [y]]
    replaceElems' x n count (y : ys) =
      -- don't replace the element, don't increment the counter
      map (y :) (replaceElems' x n count ys)
        -- replace the element, increment the counter
        ++ map (x :) (replaceElems' x n (count + 1) ys)

通过在累加器中保存所有生成的组合的列表来工作。当处理输入列表中的下一个元素(x)时,它通过以几乎所有可能的方式用x替换累加器中列表的元素来创建新的组合。然后它添加了一个新的组合,仅由x-s组成。
当替换先前生成的组合中的元素时,它不会替换所有元素,或者一个都不替换,因此不会生成两次组合。
很酷的是,它对输入列表的长度是lazy的,所以它可以生成长度为n的所有组合,即使是从一个无限列表

相关问题