haskell: оборачивание в Maybe как способ снятия ограничений на тип полиморфной функции

Решал на днях такую задачку. Дана нестрого возрастающая последовательность чисел, например [1, 2, 3, 3, 3, 4, 4, 5, 6]. Требуется построить массив строго возрастающих подпоследовательностей максимальных длин. Для приведенной последовательности первому условию будут удовлетворять списки [[1, 2, 3], [4], [5, 6]], [[1, 2], [3, 4], [5, 6]] и множество других. Второе условие требует, чтобы подпоследовательности имели максимально возможные длины. Этому условию в нашем примере удовлетворяет единственный вариант [[1, 2, 3], [4, 5, 6]]. В процессе решения задачи появилась необходимость в реализации функции splitAtEqualBounds, разбивающей исходную последовательность на подпоследовательности, граничащие друг с другом равными числами. При этом подпоследовательности, содержащие лишь один элемент должны быть отброшены как неинтересные. Так, для приведенной выше последовательности таким разбиением будет [[1, 2, 3], [3, 4], [4, 5, 6]]. Заметьте, что наша функция не требует возрастания исходной последовательности: она просто разбивает ее в областях повторения равных чисел, игнорируя длины этих областей. Реализовать функцию splitAtEqualBounds можно с помощью правой свертки исходной последовательности. В аккумуляторе будем накапливать результирующие подпоследовательности и последний прочитанный элемент-число. Представьте, что в процессе свертки мы прочли очередное число, которое отличается от того, что хранится в аккумуляторе. В этом случае мы помещаем это число в голову головного списка из аккумулятора (не в конец последнего списка, поскольку свертка правая!). В случае, если новое число совпало с числом из аккумулятора, мы добавляем в голову списка в аккумуляторе новый список, содержащий только это число. После свертки всех элементов исходной последовательности в результате получим кортеж, состоящий из списка списков чисел и уже не нужного числа, равного первому числу из исходной последовательности. Окончательный результат функции splitAtEqualBounds — это и есть этот список списков без подсписков с единственным элементом. Осталось понять, чему должно быть равно исходное значение аккумулятора. Итак, это кортеж из списка списков и некоторого числа. Этот исходный список списков согласно нашему алгоритму будет добавлен в конец результирующего списка списков. Пусть исходным значением аккумулятора будет ([[]], 0). Тогда функция splitAtEqualBounds примет вид

splitAtEqualBounds :: (Num a, Eq a) => [a] -> [[a]]
splitAtEqualBounds = filter ((>1) . length . take 2) . fst .
    foldr (\x (y@(z : zs), a) ->
        if x == a then ([x] : y, x) else ((x : z) : zs, x)) ([[]], 0)

Почему 0? Что если последним элементом исходной последовательности тоже будет 0? Оказывается, конкретное значение исходного числа в аккумуляторе при таком выборе исходного списка с единственным пустым подсписком вообще не имеет значения! Представьте, что последнее число исходной последовательности действительно равно 0. Тогда в хвосте результирующего списка списков на выходе из свертки окажется пустой подсписок, который благополучно отфильтруется функцией filter ((>1) . length . take 2). Если же последним числом исходной последовательности будет какое-либо другое число, то оно станет головой перед пустым списком, что сразу соответствует желаемому результату. Кстати, обратите внимание на использование take 2 в предикате фильтра: это простая оптимизация на случай, если подсписки окажутся очень длинными. Что плохо в этой функции? То, что мы используем явное число 0, а это ограничивает применение функции splitAtEqualBounds списками, типы элементов которых соответствуют классу Num a, то есть списками чисел. Мы не сможем применить нашу функцию к спискам строк, например. Так давайте избавимся от явного упоминания числа в аккумуляторе свертки и ограничения Num a в типе функции. Вот один из вариантов.

splitAtEqualBounds :: Eq a => [a] -> [[a]]
splitAtEqualBounds [] = []
splitAtEqualBounds x@(z : _) = filter ((>1) . length . take 2) . fst .
    foldr (\x (y@(z : zs), a) ->
        if x == a then ([x] : y, x) else ((x : z) : zs, x)) ([[]], z) $ x

Здесь мы просто связали (bind) аргумент функции x и подставили голову z вместо числа 0 в исходное значение аккумулятора. Но мне все равно не нравится такое решение, хотя функция вполне рабочая. Во-первых, пришлось добавить новый клоз для случая, когда аргументом функции является пустой список. Во-вторых, связывание аргумента, на мой взгляд, вредит элегантности кода. Ну и самое главное. Человек, не знающий, что для нашего алгоритма исходное значение числа в аккумуляторе свертки не важно, в праве задать вопрос: а почему сюда помещается первый элемент исходного списка, а не последний, например? Другими словами, использование произвольного элемента из исходного списка (мы взяли голову только потому, что это удобно и эффективно) грубо нарушает семантику (то есть смысл) исходного значения аккумулятора свертки. По смыслу, там должно находиться некоторое значение, подчеркивающее свою особенную неважность. Вот это подсказка! В haskell такое особенное значение предоставляет тип-обертка Maybe. Это значение — Nothing — особенно хорошо тем, что не ссылается на значения хранимого типа, а значит его можно использовать для исходного числа в аккумуляторе свертки без ограничений на тип функции splitAtEqualBounds. Вот ее новая реализация.

splitAtEqualBounds :: Eq a => [a] -> [[a]]
splitAtEqualBounds = filter ((>1) . length . take 2) . fst .
    foldr (\x (y@(z : zs), a) -> (,Just x) $
        if isNothing a || x == fromJust a
            then [x] : y
            else (x : z) : zs) ([[]], Nothing)

Вот теперь прекрасно видно, что исходное значение аккумулятора свертки — это просто некоторое неважное число. На этот раз для пущей элегантности я решил вынести второй элемент кортежа (раньше это был просто x, теперь Just x) вперед конструкции if: это не связано с изменением типа аккумулятора и могло быть проделано и в предыдущих вариантах функции splitAtEqualBounds. Выражение (,Just x) называется сечением кортежа (tuple section) и является расширением ghc, требующим указания опции -XTupleSections при компиляции, либо помещения строки

{-# LANGUAGE TupleSections #-}

в начало файла с исходным кодом. Кроме этого, новая реализация использует функции isNothing и fromJust из модуля Data.Maybe, поэтому в начало файла с исходным кодом следует также добавить

import Data.Maybe (isNothing, fromJust)

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

buildLongerSubseqs :: Eq a => [a] -> [[a]]
buildLongerSubseqs = filter (not . null) . build . splitAtEqualBounds
    where build []       = [[]]
          build (x : xs) = snd $ mapAccumL meltShorterAndSwap x $ xs ++ [[]]
          meltShorterAndSwap x []    = ([], x)
          meltShorterAndSwap x y
              | length x >= length y = (tail y, x) 
              | otherwise            = (y, init x)

Для использования mapAccumL нужно подключить

import Data.List (mapAccumL)

Итак, список списков, возвращенный функцией splitAtEqualBounds, передаем в локальную функцию build. Функция build реализована с помощью библиотечной функции mapAccumL — гибрида левой свертки и отображения (map). Аккумулятором нашей свертки будет список типа a, его исходным значением — первый подсписок списка, возвращенного функцией splitAtEqualBounds. Функция свертки — meltShorterAndSwap — принимает два списка. Если длина первого списка больше или равна длине второго, то она возвращает кортеж (хвост второго списка, первый список), иначе — кортеж (второй список, первый список без последнего элемента). Свертка-отображение в функции build сформирована таким образом, что в функцию meltShorterAndSwap передаются пары соседних элементов исходного списка списков, начиная с пары первый и второй подсписки (дальше это уже не пара второй и третий подсписки, а возможно измененный второй и третий подсписки — для этого и нужна функция mapAccumL, см. ниже). Поскольку последний элемент первой пары совпадает с первым элементом второй пары, то функция meltShorterAndSwap как бы стирает границу между ними, предпочитая удалять соответствующий элемент из списка наименьшей длины. Я представил этот процесс как таяние (melt) списка наименьшей длины, отсюда и название функции. Функция meltShorterAndSwap возвращает возможно измененный первый список во втором элементе кортежа, а возможно измененный второй список — в первом. Этот обмен элементами (swap) необходим, поскольку функция свертки должна возвращать для mapAccumL кортеж, первым элементом которого является аккумулятор, а вторым — строящийся список-отображение. В нашем случае в аккумулятор помещается возможно измененный в первый раз второй элемент пары (и, естественно, на следующем шаге свертки он станет кандидатом на добавление в строящийся список как первый элемент пары), а в строящийся список — возможно измененный во второй раз, ставший в прошлый раз аккумулятором, первый элемент пары. Вот так замысловато! Надо сказать, что на последнем шаге свертки останется пара возможно измененный последний подсписок и пустой список — для этого случая предусмотрен первый клоз функции meltShorterAndSwap. В списке, возвращенном функцией build могут присутствовать пустые списки. Это может произойти в случае, если исходный двух-элементный подсписок окружали подсписки большей длины. В этом случае эти большие подсписки растопят маленький список с двух сторон, превратив его в пустой список. Пустые списки удаляются из результирующего списка с помощью filter (not . null). Кстати, сравнение длин в функции meltShorterAndSwap может оказаться неэффективным, если длина одного из переданных ей списков будет значительно превышать длину второго. Если вопрос эффективности важен, можно заменить сравнение длин в охранном выражении length x >= length y на вызов новой функции isNotShorter, определив ее ниже. Вот переписанный участок исходного кода (начиная с первого клоза meltShorterAndSwap).

          meltShorterAndSwap x []  = ([], x)
          meltShorterAndSwap x y
              | x `isNotShorter` y = (tail y, x) 
              | otherwise          = (y, init x)
          isNotShorter _        []       = True
          isNotShorter []       _        = False
          isNotShorter (_ : xs) (_ : ys) = isNotShorter xs ys

Давайте проверим работу функции buildLongerSubseqs. Вот такая тестовая функция main

main :: IO ()
main = do
    let seqs = [[1, 2, 3, 3, 3, 4, 4, 5, 6],
                [1, 2, 3, 3, 4, 4, 5, 6],
                [1, 2, 3, 3, 4, 4, 5, 5, 6, 7],
                [1, 2, 3, 3, 4, 5, 5, 6, 7],
                [1, 1, 1, 2, 3, 3, 4, 5, 5, 6, 7],
                [1, 1, 1, 2, 3, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 8, 9]]
    mapM_ (\x -> putStr ">>> " >> print x >> putStr "    " >>
        print (buildLongerSubseqs x)) seqs

выводит на экран

>>> [1,2,3,3,3,4,4,5,6]
    [[1,2,3],[4,5,6]]
>>> [1,2,3,3,4,4,5,6]
    [[1,2,3],[4,5,6]]
>>> [1,2,3,3,4,4,5,5,6,7]
    [[1,2,3],[4],[5,6,7]]
>>> [1,2,3,3,4,5,5,6,7]
    [[1,2,3],[4],[5,6,7]]
>>> [1,1,1,2,3,3,4,5,5,6,7]
    [[1,2,3],[4],[5,6,7]]
>>> [1,1,1,2,3,3,4,4,5,5,6,6,6,6,7,8,9]
    [[1,2,3],[4,5],[6,7,8,9]]

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