Решал на днях такую задачку. Дана нестрого возрастающая последовательность чисел, например [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. Кроме того, она будет работать не только с возрастающими, но и с любыми другими последовательностями, разбивая исходную последовательность в областях с повторяющимися элементами.
