2

I'm trying to implement Steinhaus-Johnson-Trotter algorithm for generating permutations. My code is below:

permutations :: [a] -> [[a]]
permutations [] = []
permutations (x:[]) = [[x]]
permutations xs = [ys ++ [xs !! i] | i <- [len,len-1..0], ys <- permutations (delete i xs)]
  where len = (length xs)
        delete i xs = take i xs ++ drop (succ i) xs

This is a direct translation from the Python code:

def perms(A):
    if len(A)==1:
        yield A
    for i in xrange(len(A)-1,-1,-1):
        for B in perms(A[:i]+A[i+1:]):
            yield B+A[i:i+1]

Python code works, but Haskell code enters an infinite recursion. permutations (delete i xs) inside the list comprehension should bring the flow closer to base case. Why does infinite recursion happen?

Edit: @augustss says:

Always beware when you have multiple base cases for a function over lists.

So i changed the base case from

permutations [] = []
permutations (x:[]) = [[x]]

to more simple

permutations [] = [[]]
Improve this question
2
  • 1
    Also, your base case is wrong. Commented Jun 6, 2013 at 17:38
  • 2
    The permutations of an empty list should be [[]]. If you add that you should not have to have a special case for [x]. Always beware when you have multiple base cases for a function over lists. Commented Jun 7, 2013 at 9:57

2 Answers 2

Reset to default
4

Your loops aren't the same.

i <- [len,len-1..0]

vs

for i in xrange(len(A)-1,-1,-1):

The very first case, you're binding i to the length, not the length minus one. The result is that delete i xs returns xs, so you get infinite recursion.

I also have a couple of side notes.

First !! is linear-time. You'd be much better off writing a helper function that combines that !!, the delete, and the iteration over the input into one list traversal. Something like select :: [a] -> [(a, [a])]. You can do that efficiently.

Second, ++ is also linear time. Using it to append a single element to an existing list is slow. If your goal is just to produce all the permutations, rather than a specific ordering of them, you should probably use (xs !! i) : ys as the expression to return. (Suitably modified for any changes made in response to the first point.)

Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

1

select

Based on @Carl's answer I implemented select :: [a] -> [(a, [a])] function. It's task is to generate a list of tuples (a, [a]), where tuple's 1st part is an element from the list, and tuple's 2nd part is all elements from the list except that element.

select :: [a] -> [(a, [a])]
select [] = []
select (x:xs) = select' x [] xs
  where
    select' x left [] = [(x, left)]
    select' x left right@(r:rs) = (x, left++right) : select' r (x:left) rs

However I've found even simpler implementation of select on Haskell Libraries mailing list:

select :: [a] -> [(a,[a])]
select [] = []
select (x:xs) = (x,xs) : [(y,x:ys) | (y,ys) <- select xs]

Keep in mind that these 3 are equivalent (second is a function from Control.Arrow):

[(y,x:ys) | (y,ys) <- select xs]
map (\(y,ys) -> (y,x:ys)) (select2 xs)
map (second (x:)) (select2 xs)

Here is the example of how to use select:

select [1,2,3] -- [(1,[2,3]),(2,[1,3]),(3,[2,1])]

Before I implemented select, I tried to find functions with type [a] -> [(a, [a])] in Hayoo, there are several implementations in various libraries:

permutations

The problem is, our select is not nearly enough to generate all permutations. We can cons both parts of each tuple using uncurry (:), which has the type (a, [a]) -> [a], but we only get some permutations, not all:

map (uncurry (:)) (select [1,2,3]) -- [[1,2,3],[2,1,3],[3,2,1]]

It's clear why, select [1,2,3] creates a list [(1,[2,3]),(2,[1,3]),(3,[2,1])], but we must permute sublists, which are second parts of each tuple, too! In other words, if we have (1, [2,3]), we must add (1, [3,2]) too.

The full code for finding all permutations of a list is below:

select :: [a] -> [(a,[a])]
select [] = []
select (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (select xs)

permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [cons s2 | s <- select2 xs, s2 <- subpermutations s]
  where cons :: (a, [a]) -> [a]
        cons = uncurry (:)
        subpermutations :: (a, [a]) -> [(a, [a])]
        subpermutations (x,xs) = map (\e -> (x, e)) $ permutations xs

Note that the order of permutations of our function will be different from Data.List.permutations. Our function has lexicographic order, while Data.List.permutations hasn't:

permutations [1,2,3]           -- [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
Data.List.permutations [1,2,3] -- [[1,2,3],[2,1,3],[3,2,1],[2,3,1],[3,1,2],[1,3,2]]

Finally, if we simplify our permutations function even further, we get the implementation that is at Rosetta Code:

select :: [a] -> [(a,[a])]
select [] = []
select (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (select xs)

permutations :: [a] -> [[a]]
permutations [] = [[]]
permutations xs = [ y:zs | (y,ys) <- select xs, zs <- permutations ys]

Also note that Rosetta Code's implementation that uses insertion-based approach has the same (non-lexicographic) order as Data.List.permutations.

Notes

FWIW, there's a function scc :: [(a, [a])] -> [[a]] from package uhc-util, which finds strongly connected components of a Graph. First part of a tuple is a vertex, second part is all vertices, to which the edge from the vertex goes. IOW, graph 1 --> 2 --> 3 becomes [(1, [2]), (2, [3])].

scc [(1,[2,3,4]),(2,[1,3,4]),(3,[2,1,4]),(4,[3,2,1])] -- [[3,4], [1,2]]
Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.