Add 'subsequences' and 'permutations' to Data.List (ticket #1990)

Twan van Laarhoven twanvl at gmail.com
Tue Dec 18 21:25:09 EST 2007


David Benbennick wrote:

> On Dec 18, 2007 12:56 PM, Bertram Felgenhauer
> <bertram.felgenhauer at googlemail.com> wrote:
> 
>>finally, we could make it slightly more lazy
> 
> 
> Good point, your version is much better.
> 
> The same issue applies to permutations.  I haven't had time to write
> out the code yet, but I can imagine a version of permutations that
> does:  ...

Using mutual recursion between a version including the identity and one 
not including it, you can get:

     permutations1            :: [a] -> [[a]]
     permutations1 xxs        = xxs : permutations3b xxs
     permutations1' []        = []
     permutations1' (x:xs)    = tail $ concatMap interleave
                                         $ permutations1 xs
       where interleave []     =  [[x]]
             interleave (y:ys) =  (x:y:ys) : map (y:) (interleave ys)

Testing:

     > map (take 5) $ take 5 $ permutations1 [1..]
     [[1,2,3,4,5],[2,1,3,4,5],[2,3,1,4,5],[2,3,4,1,5],[2,3,4,5,1]]

Again this has a call to tail. We have that

    tail $ concatMap interleave $ permutations1 xs
  = tail $ concatMap interleave $ (xs : permutations1 xs)
  = tail (interleave xs ++ concatMap interleave (permutations1 xs))
  = tail (interleave xs) ++ concatMap interleave (permutations1 xs)

So making a special case for "tail . interleave":

     permutations2            :: [a] -> [[a]]
     permutations2 xxs        = xxs : permutations2' xxs
     permutations2' []        = []
     permutations2' (x:xs)    = interleave' xs
                              ++ concatMap interleave (permutations2' xs)
       where interleave ys      =  (x:ys) : interleave' ys
             interleave' []     =  []
             interleave' (y:ys) =  map (y:) (interleave ys)

The next step would be to eliminate the (++) calls in interleave. This 
is not so easy, because of the last line, "map (y:) (interleave ys)". We 
can't use the ShowS trick here directly. The way out is of course to get 
rid of the map

     permutations3            :: [a] -> [[a]]
     permutations3 xxs        = xxs : permutations3' xxs
     permutations3' []        = []
     permutations3' (x:xs)    = interleave' id xs $ foldr
                                 (interleave id) [] (permutations3' xs)
       where interleave  f ys     r =  f (x:ys) : interleave' f ys r
             interleave' f []     r =  r
             interleave' f (y:ys) r =  interleave (f . (y:)) ys r


And this is indeed a lot faster (ghc 6.8.1 -O2):
     time $ print $ sum $ map sum $ permutations $ [1..10]

     permutations2: 3.875000 sec
     permutations3: 1.625000 sec


Unfortunatly, the clarity of the algorithm has not improved.

Twan



More information about the Libraries mailing list