All list rotations in Haskell

Question

I have a function to rotate a list:

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

Now I want a function that gives a list with every possible rotation of a finite list:

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

In a imperative language, I would do something like (in pseudocode)

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

Of course, thinking imperatively probably doesn't help me find a functional solution to this problem. I'm looking for some hints as to how to tackle this.

Additional thoughts:

To solve this, I have two issues to tackle. First I need to repeatedly rotate a list and collect each result into a list. So a first solution needs to do something like

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

Of course I don't know how many times to do this. I'd be satisfied to do this infinitely and then use take (length xs) to get the finite number of lists I desire. This actually demonstrates the second issue: determining when to stop. I don't know if using take is the most efficient or elegant way to solve the problem, but it came to mind as I was typing this and should work.

Addendum: Now that I have found two solutions on my own or with hints. I will gladly welcome any other solutions that are faster or use different approaches. Thanks!

Answer 1

Use the predefined functions in Data.List! You can get a list of all rotations using four function calls, no recursion, and no rotate function.

You asked not to have a full solution posted here. For those who want to see it, a full solution (one line of code) appears at http://pastebin.com/atGiw1ig.

Answer 2

Aside from iterate, you could write a function that generates a list of n rotations. Case n=0 would just wrap the input in a list and case n=m+1 would append the input to the result of case m. Although using standard functions is generally preferred, sometimes writing your own solutions is healthy.

Answer 3

Here is a version that is fully lazy in both the list of rotations itself and each individual entry in the list. The key is is that rather than pre-compute the length, just match up the elements in your result to the elements in the list as you go, stopping when your input list runs out.

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

In addition this is much better behaved memory-wise than some of the other choices due to its use of tails and only the single concatination. Of course, it also handles infinite lists properly as well.

Answer 4

You might also want to consider this site How to define a rotates function that answers the same question.

Edit due to Comment: The implementations based on rotate as well as the one based on inits and tails should be quadratic in the length of the list. However, the one based on inits and tails should be less efficient because it performs several quadratic traversals. Though note that these statements only hold if you evaluate the result completely. Furthermore, the compiler might be able to improve the code so you have to treat these statements with caution.

Answer 5

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

this creates continues lazy rotations now just take the first unique ones, which will be equal to the length of the original list

take (length xs) (rotations xs)

Answer 6

I came up with two solutions. First is a hand-crafted one that came to me after I posted my question:

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

The other uses @Tilo's suggestion:

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

Answer 7

You could also generate them recursively. Generating all rotations of an empty or single element list is trivial, and generating the rotations of x:xs is a matter of inserting x into the correct position of all the rotations of xs.

You could do this by generating the indexes to insert into (simply the list [1, 2, ...] assuming the previous rotations are in this order) and use zipWith to insert x into the correct positions.

Alternatively you can split the rotations around the position using a combination of inits and tails and use zipWith to glue them back together.

Answer 8

Addendum: Now that I have found two solutions on my own or with hints. I will gladly welcome any other solutions that are faster or use different approaches. Thanks!

Since no else pointed out using cycle I thought I would add this solution for finite lists:

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

For an infinite list x the rotations are just tails x.

Evaluating the cycle x is O(n) time and space, each element of tails is O(1), and take n is O(n) time and space but the two take n are nested so evaluating the whole result is O(n^2) time and space.

If it garbage collects each rotation before lazily generating the next one then the space is theoretically O(n).

If you are clever about how much you are consuming then you do not need map (take n) and can just walk the cycle x or take n (tails (cycle x)) and keep the space O(n).

Answer 9

From scratch:

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)`

Or:

{-# 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

Or, integrated:

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 10

Maybe you can use Data.List

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

Answer 11

I used the following rotations function as a helper for my permutations algorithm. It seems to be the fastest among all here.

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