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

[Twan van Laarhoven]

Twan van Laarhoven wrote:
> Unfortunatly this function is really slow, 10.734375 sec, compared to 
> 3.875000 sec for the initial version (see previous message for details 
> of testing). This is of course the result of way too many (++) calls.
> 
> Twan

I agree :). I have spent some time optimizing the function (both for 
readability and speed). I ended up with

   permutations5 xs = xs : perms xs [[]]
    where
     perms []     ps = []
     perms (x:xs) ps = concatMap interleave' ps
                    ++ perms xs
                      (concatMap interleave  ps)
      where interleave  []     = [[x]]
            interleave  (y:ys) = (x:y:ys)     : map (x:) (interleave  ys)
            interleave' []     = []
            interleave' (y:ys) = (x:y:ys++xs) : map (x:) (interleave' ys)

Or using 'foldr' instead of 'concatMap'

   permutations6 xs = xs : perms xs [[]]
    where
     perms []     ps = []
     perms (x:xs) ps = (flip . foldr) (interleave' id) ps
                     $ perms xs
                     $ (flip . foldr) (interleave  id) ps []
       where interleave  f []     r  =  f [x] : r
             interleave  f (y:ys) r  =  f (x:y:ys)
                                         : interleave  (f . (y:)) ys r
             interleave' f []     r  =  r
             interleave' f (y:ys) r  =  f (x:y:ys++xs)
                                         : interleave' (f . (y:)) ys r

The (flip.foldr) is just a trick to get the arguments to foldr in the 
'right' order, i.e. (flip.foldr) :: (a -> b -> b) -> ([a] -> b -> b).

I am not too happy with this function, especially the two similar both 
subtly different interleave functions. I am not sure what version should 
go into the base library. The concatMap version (permutations5) makes 
the most sense to me, since number 6 just screams obfuscation.

Benchmark times:

   non-lazy concatMap  3.250s
   non-lazy foldr      1.500s
   lazy     concatMap  3.640s
   lazy     foldr      2.500s

Twan