Recursive permutations in Haskell
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 [] = [[]]
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.)
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:
removeEach from utility-ht package picks from HaskellForMaths package parts' from hmt-diagrams packages extractEachElem from rosso package extractElem from spaceprobe package 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]]
上一篇: 迭代适合特定键的排列
下一篇: 在Haskell中递归排列