29

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?

2
  • So you want permutations not combinations, right? Your function name seems to indicate the latter, but your example is definitely the former. Commented Oct 17, 2016 at 23:23
  • youre right, changed the questions. Commented Oct 17, 2016 at 23:31

7 Answers 7

42

Maybe you should use existing code:

import Data.List permutations [1,2,3,4] 
Sign up to request clarification or add additional context in comments.

Comments

12

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

Comments

10

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

7 Comments

rotations xs = zipWith const (iterate rotate xs) xs. (also, this, though it's in Common Lisp).
the CL code relies on surgically modifiable linked list, but it can be coded with arrays by some index juggling, I guess. In Haskell, that'd be done with some STUArray copy of the input list.
@WillNess That rotations xs = zipWith const (iterate rotate xs) xs is a great idea to eliminate len and run helper function yielding a much simplified and concise code but when benched (compiled with -O or -O2) it is slower. Like 2x slower.
yeah I had a feeling it might. :)
@Will Ness I think length $ perms [1..n] is not a reasonable performance metric in Haskell. See my Further thoughts annex above. When tested under those real world circumstances your code seems to work as fine too.
|
6

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

2 Comments

This only works if there are no duplicates in the input list. For example for input abb you would expect output abb, bab, bba but this produces ab, ba.
But you can replace filter () by delete a.
3

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!

1 Comment

My one is the same idea just the other way round: the helper function takes one list and returns a list of all the ways you can extract one element.
2

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"] 

Comments

1

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) 

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.