Get all permutations of a list in Haskell

Question

I'm trying to do this from scratch, without the use of a library outside the standard lib. Heres my code:

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

The problem is that this only produces one fork of the non-deterministic computation. Ideally I'd want

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

But I can't find a way to do this cleanly. My desired result is something like this:

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

How do I do this?

Answer 1

Maybe you should use existing code:

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

Answer 2

For a simple implementation without considering duplications in the input

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

Test:

λ> 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 3

TL&DR For faster code than Data.List.permutations, jump to Part II

Part I

I am relatively new to Haskell but I had developed a very efficient permutations algorithm for JS. It almost beats the heaps algorithm, yet in JS, rotating an array is more costly compared to lazy Haskell iterate function over the lists. So this one, unlike all the provided answers above seems to be much more efficient.

The built in Data.List.permutations is still like 2x faster than this one as of today since i don't know the performance constraints of Haskell at all. May be someone here could help me to push this code a little forward.

So I have a helper function which returns a list of all rotations of the provided list. Such as

rotations [1,2,3] would yield [[1,2,3],[2,3,1],[3,1,2]]

accordingly the perms function is;

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)

Part II

So i have been thinking on how to make the above code more efficient. OK the lists in Haskell are linked lists and unlike JavaScript the length is not a property that you can access in O(1) time but O(n). It's a function traversing the whole damn list, basically counting all the items in the list. Hence very expensive if used repeatedly. That happens to be what exactly we do by take (length xs) instruction in each invocation of the rotate function. We literally invoke it millions of times if your input list is like 10-11 items or more in length. Cutting it would yield huge savings. Then lets not make it calculate the length of the same length lists over an over but instead let's simply provide it like;

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

Beautiful. Well, now we have to slightly modify our perms function accordingly like;

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

so obviously il is now assigned to the input list and len caches it's length. Now this is beautiful and quite interestingly, compared to the default Data.List.permutations, it runs like 1.33 times faster in GHCI and 3+ times faster when compiled with -O2.

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)

The thing is, if you could make the rotations function more efficient you can get better results alas i have done some researches but that simple code seems to be as good as it gets in Haskell.

One other important point is, i believe this algorithm is also threadable (havent yet tested that) but it should be since if you check the run n (x:xs) = concatMap ((rotations n).(x:)) (run (n-1) xs) part you may notice that we have a map with the rotations n . (x:) function over the previous set of permutations. That's exactly the place where i can spawn threads i think.

Further thoughts... "Am I really doing the right thing..?"

I think i am being deceived by the laziness here. I believe doing like length $ perms [1..12] does not really enforce the permutations to resolve but just works up until it knows the length of the permutations list which is 12!. I mean the contained values are possibly still thunks.

So instead of length, i decided to do like any (== [11,1,7,2,10,3,8,4,12,5,9,6]) $ perms [1..12] where [11,1,7,2,10,3,8,4,12,5,9,6] is the last permutation element of the perms algorithm. So now i guess it shall evaluate all the thunks for an equity check up until it reaches the last element to return a True.

When checked like this perms and permutations with their own last elements, resolve at similar pace (permutations being slightly faster).

Any ideas are welcome...

Answer 4

I think that this is shorter and more elegant variant for what others are suggesting:

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

Answer 5

Everything is better with monads:

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

So: you have a function, that inserts letter in a word, but it produces more then one word, so how to apply it recursively? >>= helps!

Answer 6

I solved this problem and then found this discussion. Here is a short solution that uses recursion. The first argument to doPerm contains elements eligible for any position in the permutation, the second argument elements that are only eligible for other positions than the first one.

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)

Here is an example run:

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

Answer 7

It's already in the standard base library, so no need to struggle. If you really want to see how to do it, you can look at the source of that library.

Answer 8

I'd do it like this:

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)