
I ran into a fun question today: http://stackoverflow.com/q/36342967/1477667 Specifically, it asks how to find all ways to interleave lists so that the order of elements within each list is preserved. The most efficient way I found is copied below. It's nicely lazy, and avoids left-nested appends. Unfortunately, it's pretty seriously ugly. Does anyone have any idea of a way to do this that's both efficient and elegant? {-# LANGUAGE BangPatterns #-} import Data.Monoid import Data.Foldable (toList) import Data.Sequence (Seq, (|>)) -- Find all ways to interleave two lists interleave2 :: [a] -> [a] -> [[a]] interleave2 xs ys = interleave2' mempty xs ys [] -- Find all ways to interleave two lists, adding the -- given prefix to each result and continuing with -- a given list to append interleave2' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]] interleave2' !prefix xs ys rest = (toList prefix ++ xs ++ ys) : interleave2'' prefix xs ys rest -- Find all ways to interleave two lists except for -- the trivial case of just appending them. Glom -- the results onto the given list. interleave2'' :: Seq a -> [a] -> [a] -> [[a]] -> [[a]] interleave2'' !prefix [] _ = id interleave2'' !prefix _ [] = id interleave2'' !prefix xs@(x : xs') ys@(y : ys') = interleave2' (prefix |> y) xs ys' . interleave2'' (prefix |> x) xs' ys -- What the question poser wanted; I don't *think* there's -- anything terribly interesting to do here. interleavings :: [[a]] -> [[a]] interleavings = foldr (concatMap . interleave2) [[]] Thanks, David