-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.List
, intersperse -- :: a -> [a] -> [a]
, intercalate -- :: [a] -> [[a]] -> [a]
, transpose -- :: [[a]] -> [[a]]
+
+ , subsequences -- :: [a] -> [[a]]
+ , permutations -- :: [a] -> [[a]]
-- * Reducing lists (folds)
transpose :: [[a]] -> [[a]]
transpose [] = []
transpose ([] : xss) = transpose xss
-transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : transpose (xs : [ t | (h:t) <- xss])
+transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss])
-- | The 'partition' function takes a predicate a list and returns
{-# INLINE partition #-}
partition p xs = foldr (select p) ([],[]) xs
+select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])
select p x ~(ts,fs) | p x = (x:ts,fs)
| otherwise = (ts, x:fs)
-- The list must be finite and non-empty.
maximumBy :: (a -> a -> Ordering) -> [a] -> a
maximumBy _ [] = error "List.maximumBy: empty list"
-maximumBy cmp xs = foldl1 max xs
+maximumBy cmp xs = foldl1 maxBy xs
where
- max x y = case cmp x y of
- GT -> x
- _ -> y
+ maxBy x y = case cmp x y of
+ GT -> x
+ _ -> y
-- | The 'minimumBy' function takes a comparison function and a list
-- and returns the least element of the list by the comparison function.
-- The list must be finite and non-empty.
minimumBy :: (a -> a -> Ordering) -> [a] -> a
minimumBy _ [] = error "List.minimumBy: empty list"
-minimumBy cmp xs = foldl1 min xs
+minimumBy cmp xs = foldl1 minBy xs
where
- min x y = case cmp x y of
- GT -> y
- _ -> x
+ minBy x y = case cmp x y of
+ GT -> y
+ _ -> x
-- | The 'genericLength' function is an overloaded version of 'length'. In
-- particular, instead of returning an 'Int', it returns any type which is
tails xxs@(_:xs) = xxs : tails xs
+-- | The 'subsequences' function returns the list of all subsequences of the argument.
+--
+-- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
+subsequences :: [a] -> [[a]]
+subsequences xs = [] : nonEmptySubsequences xs
+
+-- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
+-- except for the empty list.
+--
+-- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
+nonEmptySubsequences :: [a] -> [[a]]
+nonEmptySubsequences [] = []
+nonEmptySubsequences (x:xs) = [x] : foldr f [] (nonEmptySubsequences xs)
+ where f ys r = ys : (x : ys) : r
+
+
+-- | The 'permutations' function returns the list of all permutations of the argument.
+--
+-- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
+permutations :: [a] -> [[a]]
+permutations xs0 = xs0 : perms xs0 []
+ where
+ perms [] _ = []
+ perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
+ where interleave xs r = let (_,zs) = interleave' id xs r in zs
+ interleave' _ [] r = (ts, r)
+ interleave' f (y:ys) r = let (us,zs) = interleave' (f . (y:)) ys r
+ in (y:us, f (t:y:us) : zs)
+
+
------------------------------------------------------------------------------
-- Quick Sort algorithm taken from HBC's QSort library.
mergesort cmp = mergesort' cmp . map wrap
mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]
-mergesort' cmp [] = []
-mergesort' cmp [xs] = xs
+mergesort' _ [] = []
+mergesort' _ [xs] = xs
mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)
merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]
-merge_pairs cmp [] = []
-merge_pairs cmp [xs] = [xs]
+merge_pairs _ [] = []
+merge_pairs _ [xs] = [xs]
merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss
merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
-merge cmp [] ys = ys
-merge cmp xs [] = xs
+merge _ [] ys = ys
+merge _ xs [] = xs
merge cmp (x:xs) (y:ys)
= case x `cmp` y of
GT -> y : merge cmp (x:xs) ys
-- | A strict version of 'foldl'.
foldl' :: (a -> b -> a) -> a -> [b] -> a
#ifdef __GLASGOW_HASKELL__
-foldl' f z xs = lgo z xs
+foldl' f z0 xs0 = lgo z0 xs0
where lgo z [] = z
lgo z (x:xs) = let z' = f z x in z' `seq` lgo z' xs
#else