在 Haskell 中获取列表的所有排列

Question

我正在尝试从头开始，不使用标准库之外的库。这是我的代码：

permutations :: [a] -> [[a]]
permutations (x:xs) = [x] : permutations' xs
    where permutations' (x:xs) = (:) <$> [x] <*> split xs
            split l = [[x] | x <- l]

问题在于，这只产生了非确定性计算的一个分支。理想情况下我想要

(:) <$> [x] <*> ((:) <$> [x] <*> ((:) <$> [x] <*> ((:) <$> [x] <*> xs)))

但我找不到干净利落的方法。我想要的结果是这样的：

permutations "abc" -> ["abc", "acb", "bac", "bca", "cab", "cba"]

我该怎么做？

Answer 1

我解决了这个问题，然后找到了这个讨论。这是一个使用递归的简短解决方案。 doPerm 的第一个参数包含适用于排列中任何位置的元素，第二个参数元素仅适用于第一个以外的其他位置。

permutations :: [a] -> [[a]]
permutations xs = doPerm xs []
  where
    doPerm [] _ = [[]]
    doPerm [y] ys = (y:) <$> doPerm ys []
    doPerm (y : ys) zs = doPerm [y] (ys ++ zs) ++ doPerm ys (y : zs)

这是一个运行示例：

λ> permutations "abc"
["abc","acb","bca","bac","cba","cab"]

Answer 2

TL&DR 要获得比 Data.List.permutations 更快的代码，请跳至第二部分

第一部分

我对 Haskell 比较陌生，但 I had developed a very efficient permutations algorithm for JS。它几乎击败了堆算法，但在 JS 中，与列表上的惰性 Haskell iterate 函数相比，旋转数组的成本更高。因此，与上面提供的所有答案不同，这个似乎更有效率。

截至今天，内置的Data.List.permutations 仍然比这个快 2 倍，因为我根本不知道 Haskell 的性能限制。可能有人可以帮助我将这段代码向前推进一点。

所以我有一个辅助函数，它返回所提供列表的所有旋转的列表。比如

rotations [1,2,3] 将产生 [[1,2,3],[2,3,1],[3,1,2]]

因此 perms 函数是；

rotations :: [a] -> [[a]]
rotations xs = take (length xs) (iterate (\(y:ys) -> ys ++ [y]) xs)

perms :: [a] -> [[a]]
perms []     = [[]]
perms (x:xs) = concatMap (rotations.(x:)) (perms xs)

第二部分

所以我一直在思考如何让上面的代码更有效率。好的，Haskell 中的列表是链表，与 JavaScript 不同，长度不是您可以在 O(1) 时间内访问的属性，而是 O(n)。这是一个遍历整个该死列表的函数，基本上是计算列表中的所有项目。因此，如果重复使用非常昂贵。这恰好是我们在每次调用 rotate 函数时通过 take (length xs) 指令所做的。如果您的输入列表长度为 10-11 项或更多，我们实际上会调用它数百万次。削减它会产生巨大的节省。然后让我们不要让它计算相同长度列表的长度，而是让我们简单地提供它;

rotations :: Int -> [a] -> [[a]]
rotations len xs = take len (iterate (\(y:ys) -> ys ++ [y]) xs)

美丽。好吧，现在我们必须相应地稍微修改我们的perms 函数：

perms :: [a] -> [[a]]
perms []        = [[]]
perms il@(x:xs) = concatMap ((rotations len).(x:)) (perms xs)
                  where len = length il

很明显il 现在分配给i输入list 和len 缓存它的长度。现在这很漂亮，也很有趣，与默认的 Data.List.permutations 相比，它在 GHCI 中的运行速度像 1.33 倍，在使用 -O2 编译时快 3+ 倍。

import Data.List

perms :: [a] -> [[a]]
perms xs = run len xs
           where
           len = length xs

           rotate :: [a] -> [a]
           rotate (x:xs) = xs ++ [x]

           rotations :: Int -> [a] -> [[a]]
           rotations l xs = take l (iterate rotate xs)

           run :: Int -> [a] -> [[a]]
           run _ []      = [[]]
           run _ [x]     = [[x]]
           run n (x:xs)  = run (n-1) xs >>= rotations n . (x:)
           --run n (x:xs)  = concatMap ((rotations n).(x:)) (run (n-1) xs)

λ> length $ perms [1..13]
6227020800
(302.58 secs, 1,366,730,140,472 bytes)

λ> length $ permutations [1..13]
6227020800
(404.38 secs, 1,800,750,142,384 bytes)

问题是，如果您可以使 rotations 函数更高效，您可以获得更好的结果，虽然我已经进行了一些研究，但这个简单的代码似乎与 Haskell 中的代码一样好。

另一个重要的一点是，我相信这个算法也是可线程的（还没有测试过）但它应该是因为如果你检查run n (x:xs) = concatMap ((rotations n).(x:)) (run (n-1) xs) 部分，你可能会注意到我们有一个map 和rotations n . (x:)作用于前一组排列。我认为这正是我可以产生线程的地方。

进一步的想法……“我真的做对了……吗？”

我想我被这里的懒惰欺骗了。我相信像length $ perms [1..12] 这样的操作并没有真正强制解决排列，而是一直工作直到它知道排列列表的长度为12！。我的意思是包含的值可能仍然是 thunk。

所以我决定不使用length，而是使用any (== [11,1,7,2,10,3,8,4,12,5,9,6]) $ perms [1..12]，其中[11,1,7,2,10,3,8,4,12,5,9,6] 是perms 算法的最后一个排列元素。所以现在我想它应该评估所有 thunk 以进行权益检查，直到它到达最后一个元素以返回 True。

当像这样检查perms 和permutations 以及它们自己的最后一个元素时，以相似的速度解决（permutations稍微快一些）。

欢迎提出任何想法...

Answer 3

对于其他人的建议，我认为这是更短、更优雅的变体：

permutate :: (Eq a) => [a] -> [[a]]
permutate [] = [[]]
permutate l = [a:x | a <- l, x <- (permutate $ filter (\x -> x /= a) l)]

Answer 4

也许你应该使用现有的代码：

import Data.List
permutations [1,2,3,4]

Answer 5

我会这样做：

select :: [a] -> [(a,[a])]
select = select' id where
  select' _ [] = []
  select' acc (a:r) = (a, acc r) : select' (acc . (a:)) r

permutations [] = [[]]
permutations l = do
  (a,r1) <- select l
  r2 <- permutations r1
  return (a: r2)

Answer 6

使用 monad 一切都会变得更好：

perm :: [a] -> [[a]]
perm []     = return []
perm (x:xs) = (perm xs) >>= (ins x)
    where
    ins :: a -> [a] -> [[a]]
    ins x []     = [[x]]
    ins x (y:ys) = [x:y:ys] ++ ( map (y:) (ins x ys) )

所以：你有一个函数，可以在一个单词中插入字母，但它产生的单词不止一个，那么如何递归地应用它呢？ >>= 有帮助！

Answer 7

对于不考虑输入重复的简单实现

permutations :: Eq a => [a] -> [[a]]
permutations [] = [[]]
permutations as = do a <- as
                     let l = delete a as
                     ls <- permutations l
                     return $ a : ls

测试：

λ> permutations [1,2,3]
[[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
λ> permutations "abc"
["abc","acb","bac","bca","cab","cba"]
λ> 

Algorithm Reference

Answer 8

它已经在标准的base 库中，因此无需费力。如果你真的想看看怎么做，你可以看看那个库的源代码。