Haskell中的所有列表轮换[重复]

Question

我有一个旋转列表的功能：

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

现在我想要一个函数，它给出一个有限列表的每个可能旋转的列表：

rotateAll :: [a] -> [[a]]

在命令式语言中，我会做类似（在伪代码中）

for i = 1 to length of list
  append list to rotateList
  list = rotate(list)

当然，命令式思考可能无法帮助我找到解决这个问题的有效方法。我正在寻找一些关于如何解决这个问题的提示。

其他想法：

为了解决这个问题，我有两个问题要解决。首先，我需要反复轮换一个列表并将每个结果收集到一个列表中。所以第一个解决方案需要做类似的事情

rotateAll xs = [xs (rotate xs) (rotate (rotate xs)) (rotate (rotate (rotate xs))) ...]

当然，我不知道要这样做多少次。我很乐意无限地执行此操作，然后使用take (length xs) 来获得我想要的有限数量的列表。这实际上说明了第二个问题：确定何时停止。我不知道使用 take 是否是解决问题的最有效或最优雅的方法，但在我输入此内容时我想到了它并且应该可以工作。

附录： 现在我已经找到了两种解决方案，或者有提示。我很乐意欢迎任何其他更快或使用不同方法的解决方案。谢谢！

Answer 1

使用Data.List中的预定义函数！您可以使用四个函数调用、没有递归和没有rotate 函数来获取所有旋转的列表。

您要求不要在此处发布完整的解决方案。想看的朋友可以在http://pastebin.com/atGiw1ig看到完整的解决方案（一行代码）。

Answer 2

除了iterate，您还可以编写一个函数来生成一个包含 n 个旋转的列表。 case n=0 只会将输入包装在一个列表中，而 case n=m+1 会将输入附加到 case m 的结果中。虽然通常首选使用标准函数，但有时编写自己的解决方案是健康的。

Answer 3

这是一个在轮换列表本身和列表中的每个单独条目中都完全惰性的版本。关键是，与其预先计算长度，不如将结果中的元素与列表中的元素进行匹配，当输入列表用完时停止。

rotations xs = map (takeSame xs) $ takeSame xs (tails (xs ++ xs)) where
    takeSame [] _ = [] 
    takeSame (_:xs) (y:ys) = y:takeSame xs ys

此外，由于它使用了尾部并且只有单一的连接，因此它在内存方面的表现比其他一些选择要好得多。当然，它也能正确处理无限列表。

Answer 4

您可能还想考虑这个回答相同问题的网站How to define a rotates function。

因评论而编辑： 基于rotate 的实现以及基于inits 和tails 的实现在列表长度上应该是二次的。但是，基于inits 和tails 的算法效率应该较低，因为它执行了多次二次遍历。尽管请注意，这些陈述仅在您完全评估结果时才成立。此外，编译器可能会改进代码，因此您必须谨慎对待这些语句。

Answer 5

rotations (x:xs) = (xs++[x]):(rotations (xs++[x]) ) 

这会创建持续的惰性旋转 现在只取第一个唯一的，这将等于原始列表的长度

take (length xs) (rotations xs)

Answer 6

我想出了两个解决方案。第一个是我发布问题后收到的手工制作的：

rotateAll :: [a] -> [[a]]
rotateAll xs = rotateAll' xs (length xs)
    where rotateAll' xs 1 = [xs]
          rotateAll' xs n = xs : rotateAll' (rotate xs) (n - 1)

其他人使用@Tilo的建议：

rotateAll :: [a] -> [[a]]
rotateAll xs = take (length xs) (iterate rotate xs)

Answer 7

您也可以递归地生成它们。生成空或单个元素列表的所有旋转是微不足道的，生成x:xs 的旋转只需将x 插入xs 的所有旋转的正确位置即可。

您可以通过生成要插入的索引来做到这一点（只需列表 [1, 2, ...] 假设先前的旋转按此顺序）并使用 zipWith 将 x 插入正确的位置.

或者，您可以使用inits 和tails 的组合来split 围绕位置旋转，然后使用zipWith 将它们粘在一起。

Answer 8

附录：现在我自己找到了两种解决方案，或者有提示。 我很乐意欢迎任何其他更快或使用的解决方案 不同的方法。谢谢！

由于没有其他人指出使用cycle，我想我会为有限列表添加这个解决方案：

rotations x = let n = length x in map (take n) $ take n (tails (cycle x))

对于无限列表x，旋转只是tails x。

评估cycle x是O(n)时间和空间，tails的每个元素是O(1)，take n是O(n)时间和空间但是两个take n是嵌套的所以评估整个结果是 O(n^2) 时间和空间。

如果它在懒惰地生成下一个旋转之前垃圾收集每个旋转，那么空间理论上是 O(n)。

如果你很清楚自己的消费量，那么你就不需要map (take n)，只需走cycle x 或take n (tails (cycle x)) 并保持空间O(n)。

Answer 9

也许你可以使用Data.List

import Data.List
rotate x=[take (length x) $ drop i $ cycle x | i<-[0..length x-1]]

Answer 10

从头开始：

data [] a = [] | a : [a]

end :: a -> [a] -> [a]
end y []       = y : []
end y (x : xs) = x : y `end` xs

-- such that `end x xs  =  xs ++ [x]`

rotating :: [a] -> [[a]]
rotating [] = []
rotating xs = rots xs
   where
      rots xs@(x : xs') = xs : rots (x `end` xs')

-- An infinite list of rotations

rotations :: [a] -> [[a]]
rotations xs = rots xs (rotating xs)
   where
      rots []       _        = []
      rots (_ : xs) (r : rs) = r : rots xs rs

-- All unique rotations, `forall xs.` equivalent to `take
-- (length xs) (rotating xs)`

或者：

{-# LANGUAGE BangPatters #-}

rotate :: [a] -> [a]
rotate []       = []
rotate (x : xs) = x `end` xs
   where
      end y []       = y : []
      end y (x : xs) = x : end y xs

iterate :: Int -> (a -> a) -> a -> [a]
iterate 0 _ _ = []
iterate n f x = case f x of
                   x' -> x' : iterate (n - 1) f x'

length :: [a] -> Int
length xs = len 0 xs
   where
      len !n []       = n
      len !n (_ : xs) = len (n + 1) xs

rotations :: [a] -> [[a]]
rotations xs = iterate (length xs) rotate xs

-- Starting with single rotation

或者，集成：

rotations :: [a] -> [[a]]
rotations [] = [[]]
rotations xs = rots xs xs
   where
      rots []       _            = []
      rots (_ : xc) xs@(x : xs') = xs : rots xc (x `end` xs')

      end y []       = y : []
      end y (x : xs) = x : end y xs

Answer 11

我使用以下rotations 函数作为permutations algorithm 的助手。它似乎是这里最快的。

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