Недостатки наивной реализации interleave

Требуется написать функцию с сигнатурой

> interleave :: [a] -> [a] -> [a]

которая возвращает список, образованный перемежением элементов исходных списков. Например:

*Main> interleave [1,2,3] [4,5,6,7,8]
[1,4,2,5,3,6,7,8]
*Main> interleave [1,2] []
[1,2]

Скорее всего, вы почти моментально придете к следующему определению:

> interleave [] ys = ys
> interleave xs [] = xs
> interleave (x:xs) (y:ys) = x:y:interleave xs ys

Всего три строки, где две отведены под очевидные базовые случаи. Что может быть проще? Однако, в этой реализации есть едва уловимый изъян - она черезчур строгая.

*Main> take 3 $ interleave [1,2] (3:error "Oops!")
[1,3*** Exception: Oops!

Что произошло? Мы сопоставили с образцом [] список error "Oops!", в то время как это было ненужно.

Как это справить? Просто отложить сопоставление с паттерном для второго списка до тех пор, пока его элементы действительно не понадобятся.

interleave' [] ys = ys
interleave' (x:xs) ys = x : (
  case ys of
    []     -> xs
    (y:ys) -> y : interleave' xs ys
  )

Или так (если заметить, что выражение в скобках есть вызов interleave' cо списками ys и xs), что элегантнее:

> interleave' :: [a] -> [a] -> [a]
> interleave' []     ys = ys
> interleave' (x:xs) ys = x:interleave' ys xs

Пример с ошибкой, бросаемой хвостом второго списка, кажется надуманным, ведь обычно мы производим вычисления над вполне определенными и конечными списками (например, данными, прочтенными с жесткого диска). Однако, все меняется, когда мы пытаемся оперировать бесконечными списками, в этому случае нужно очень аккуратно следить за тем, что форсится, что - нет.

С выражением типа

[1..] `interleave` [1..]

все в порядке, но что если, второй аргумент в interleave сам в свою очередь вычисляется через применение interleave? Например:

let x = take 1 $ foldr1 interleave (repeat [1..])

что разворачивается в бесконечную право-вложенную последовательность применений interleave к [1..]:

let x = take 1 $ [1..] `interleave` (
                 [1..] `interleave` (
                 [1..] `interleave` ...))

Для того, чтобы вычислить x достаточно зафорсить первый [1..] до конструктора (:), но наивная версия interleave вместе с тем зафорсит до конструктора списка и второй аргумент interleave:

                 ([1..] `interleave` (
                  [1..] `interleave` ...))

и так далее… В итоге, программа зависает в бесконечном цикле.

Можно переписать этот пример несколько иначе:

let x = take 1 $ let y = [1..] `interleave` y
                 in  y

что семантически то же самое, но зависать вычисление x будет по слегка иной причине.

К счастью, наша максимально ленивая версия interleave' решает эти зависания и x благополучно вычисляется до [1].

interleave' можно использовать как замену (++) в случае генерации элементов счетного множества, при этом использование interleave' дает гарантии, что каждый элемент множества рано или поздно встретится в результирующей последовательности.

Пример с сериализацией бесконечной таблицы:

> table2D :: [[(Int,Int)]]
> table2D = map (zip [1..] . repeat) [1..]

> serializeTable :: [[a]] -> [a]
> serializeTable = foldr1 interleave'

*Main> take 10 $ serializeTable table2D
[(1,1),(1,2),(2,1),(1,3),(3,1),(2,2),(4,1),(1,4),(5,1),(3,2)]

Это похоже на диагонализацию Кантора, однако, не является ею, потому что элементы первого ряда в исходной таблице встречаются в результирующей последовательности в два раза чаще, чем элементы второго ряда, в четыре раза чаще, чем третьего, в восемь, чем четвертого и так далее по степеням двойки.

Тем не менее, эта программа может точно так же может служить доказательством счетности множества рациональных чисел.

Еще один пример использования interleave' - это генерация выражений в некотором языке.

Термы языка представляются объектами типа:

> data Exp = Lit Int
>          | Add Exp Exp
> 
> instance Show Exp where
>   show (Lit i) = show i
>   show (Add x y) = "(" ++ show x ++ "+" ++ show y ++ ")"

Тогда генератор термов можно выразить, следуя структуре этого ADT:

> genExp :: [Exp]
> genExp = map Lit [1..3] `interleave'`
>          map (uncurry Add) (genExp `cartesian` genExp)

где cartesian перемножает множества и сериализует результат, подобно тому, как это делалось в serializeTable:

> cartesian :: [a] -> [b] -> [(a,b)]
> cartesian []     _  = []
> cartesian (x:xs) ys = map (x,) ys `interleave'`
>                       cartesian xs ys

В итоге:

*Main> mapM_ (putStrLn . show) $ take 10 genExp
1
(1+1)
2
((1+1)+1)
3
(1+(1+1))
(2+1)
(1+2)
((1+1)+(1+1))
(1+((1+1)+1))