Из пушек по воробьям. Генерация и решение лабиринта не самым обычным способом

На уходящей неделе мне попалась симпатичная, хоть и не новая мини‑серия статей на Дзен‑канале @zdgzdgzdg про процедурную генерацию лабиринта методом «коллапса волновой функции». Пока я читал эти статьи и знакомился с кодом, меня осенило: ведь это же вычисления в комонаде, погружённые в монаду! Я не издеваюсь, действительно, речь идёт о композиции двух паттернов функционального программирования: комонады Zipper, превращающей локальные правила в глобальное состояние, и монады Random, позволяющей генерировать случайные объекты.

И вот, в качестве баловства на выходных, я решил реализовать этот «квантовый» алгоритм генерации лабиринтов на Haskell, используя и комонады и монады, и вообще, ни в чëм себе не отказывая. И хотя язык программирования Haskell нужен не только для извращений, но именно для них он подходит идеально!

Цель этого мини‑проекта не code‑golf (то есть, максимальное сокращение кода) и не поиск оптимального решения, а proof of concept: демонстрация того, что этот алгоритм действительно вполне естественным образом выражается композицией монады и комонады.

Для тех, кому лень читать, или страшно смотреть код на Haskell, объясню в двух словах суть подхода. Мы детально описываем локальный алгоритм, то есть всë, что касается одного элемента лабиринта, а затем используем «волшебство» комонад и монад и специально подобранные структуры данных для того, чтобы во‑первых, превратить локальный алгоритм в глобальный, то есть, автоматически распространить его на весь, потенциально бесконечный лабиринт, а во‑вторых, гладко протащить через это расширение генерацию случайных чисел. После этого мы используем анаморфизмы и катаморфизмы для того, чтобы отыскать выход из полученного лабиринта.

Генерируем лабиринт

Канонический алгоритм генерации лабиринта недетерминированно заполняет двумерный массив ячеек, изменяя их состояние с учётом состояния соседей и используя элемент случайности. Он хорошо и с картинками описан в указанной выше серии статей и его легко отыскать в YouTube. Случайность, изменяемое состояние, массив с произвольным доступом… такое сочетание для чистого функционального языка программирования это чистое издевательство и повод поменять либо язык, либо задачу. Но не тут‑то было! Вызов принят!

Поскольку упомянутые мной заумные концепции соответствуют парадигме программирования, управляемого данными (DDD), то начать стоит с данных и их типов.

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

-- | Представление квадратной ячейки type Cell = ( Int, Int             , Int, Int )   showCell :: Cell -> String showCell = \case   (1,0,0,0) -> "▀ "   (0,1,0,0) -> " ▀"   (0,0,1,0) -> "▄ "   (0,0,0,1) -> " ▄"   (1,1,0,0) -> "▀▀"   (0,1,0,1) -> " █"   (1,0,1,0) -> "█ "   (0,0,1,1) -> "▄▄"   _         -> "  "

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

-- | Представление состояния ячейки type State = [Cell]       -- | Список всех валидных состояний клеток лабиринта. states :: State states = [ (0,0,0,1), (0,0,1,0)          , (0,1,0,0), (1,0,0,0)          , (0,0,1,1), (0,1,0,1)          , (1,0,1,0), (1,1,0,0) ]  showState :: State -> String showState = \case   []  -> "░░"   [x] -> showCell x   xs  -> show (length xs) <> " "

Опишем теперь какие состояния сочетаются друг с другом. В упомянутой выше статье для этого использовался словарь, мы же определим простую функцию-предикат:

-- | Представление направления data Dir = R | L | U | D    deriving (Eq, Show)  -- | Предикат смежности для клеток лабиринта по указанным направлениям adjacent :: Dir -> Cell -> Cell -> Bool adjacent R (_,a,_,b) (c,_,d,_) = a*c + b*d /= 0 adjacent D (_,_,a,b) (c,d,_,_) = a*c + b*d /= 0 adjacent L a b = adjacent R b a adjacent U a b = adjacent D b a

Первым аргументом предиката указано направление, вдоль которого происходит стыковка ячеек. Для представления этих направлений определëн простой тип‑перечисление Dir.

Концептуально, алгоритм состоит из двух частей: детерминистической и стохастической, то есть, имеющей элементы случайности. В первой части происходит ограничение возможных состояний ячейки в соответствии с состояниями еë соседей. Во второй происходит фиксация состояния ячейки в какое-то одно состояние из множества возможных. Сейчас мы готовы сформулировать те части алгоритма, которые относятся к состояниям одной ячейки.

-- | Детерминистическая часть алгоритма для одной ячейки и её соседей adjust :: State -> [(Dir, State)] -> State adjust = \cases {-1-} []    []  -> [] {-2-} [x]   _   -> [x] {-3-} []    nbs -> adjust states nbs {-4-} state nbs -> let         res = nub [ s | s <- state                   , (d, nb) <- nbs                   , any (adjacent d s) nb ]         in if length res == 8 then [] else res

Эта функция принимает два аргумента: состояние ячейки и список её соседей, с указанием направления к каждому из них. При этом указываются только те соседи, состояние которых хоть как‑то определено. В теле функции описываются четыре варианта поведения в зависимости от состояния клетки и её соседей.

1. Если не определены ни ячейка, ни её окружение, то она остаётся неопределённой.

2. Если ячейка находится в единственном состоянии, то возвращаем это состояние, игнорируя соседей.

3. Если состояние ячейки не определено, но какие‑то из соседей уже частично или полностью коллапсировали, то рассматриваем её состояние как суперпозицию всех возможных состояний.

4. Общий случай, который фильтрует те состояния, которые согласуются с соседями, используя генератор списков, как в Python. При этом если в результат входят все возможные варианты, то мы считаем такое состояние неопределённым.

После того, как число состояний клетки уменьшилось, нам предстоит случайно выбрать один из возможных вариантов. Этим займётся функция collapse:

-- | Стохастическая часть алгоритма для одной ячейки collapse :: Rational -> State -> Random State collapse p = \case {-1-} [x]   -> return [x] {-2-} []    -> do x <- uniform states                   fromList [([x], p), ([], 1)] {-3-} state -> do x <- uniform state                   return [x]

Она принимает два аргумента: вероятность p и состояние ячейки. При этом возможны три варианта:

1. Если ячейка находится в единственном состоянии, то возвращаем его.

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

3. Для суперпозиций состояний мы возвращаем одно из них.

Тип этой функции говорит о том, что её результатом будет не просто состояние ячейки, а случайное. Функция uniform выбирает из списка элемент, считая, что все они распределены равномерно. А функция fromList выбирает случайные элементы с указанными вероятностями.

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

Пока всë достаточно просто, если не считать особенностей синтаксиса языка Haskell. Функциональное программирование тут пока ещё не начиналось. Пора, наконец погрузиться в его причудливый мир!

Самое главное свойство функций adjust и collapse состоит в том, что они локальны. Это значит, что они оперируют только состоянием какой‑то одной ячейки и состояниями её непосредственных соседей. Этот паттерн характерен многих задач:

• клеточных автоматов,

• фильтрации сигналов и изображений,

• свëртки и корреляции временных рядов,

• численных методов матфизики (типа метода конечных разностей),

• вычисления таблиц с взаимными ссылками (spreadsheets, как в Lotus или Excell) и так далее.

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

Для этого мы воспользуемся не списком списков, а структурой, которая называется зиппером или лентой (Tape). Она представляет собой массив, разделённый на части, относительно курсора — выделенного элемента ленты. В одномерном варианте эта структура определяется двумя бесконечными списками или потоками, представляющими данные, расположенные впереди курсора и позади него.

-- | Бесконечная лента с курсором. data Tape a = Tape [a] a [a]  -- |  Курсор и его соседи cursor (Tape _ x _) = x viscinity (Tape (b:_) _ (f:_)) = (b, f)  -- | Перемещения по ленте back (Tape (a:as) x bs    ) = Tape as     a (x:bs) forw (Tape as     x (b:bs)) = Tape (x:as) b bs

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

-- | Инициализатор ленты значением по умолчанию и списком заданных значений tape :: a -> [a] -> Tape a tape d xs =   forw $ Tape (repeat d) d (xs ++ repeat d)  -- | Представление конечного участка ленты в виде списка takeT :: Int -> Tape a -> [a] takeT n (Tape _ x xs) = take n (x:xs)

На базе ленты строится двумерная структура, которую мы будем называть полем или решёткой (Grid). Это лента, элементами которой являются другие ленты:

-- | Бесконечное поле с курсором в указанной позиции. data Grid a = Grid { pos     :: (Int, Int)                    , getGrid :: Tape (Tape a) }  -- | Инициализатор для поля значением по умолчанию  и списком  заданных значений. grid :: a -> [[a]] -> Grid a grid d = Grid (0,0) . tape (tape d []) . fmap (tape d)  -- | Представление конечного участка поля. takeG :: Int -> Grid a -> [[a]] takeG n (Grid _ g) = takeT n $ takeT n <$> g 

Структура Grid позволяет легко и быстро определить функцию, возвращающую список соседей курсора в формате, необходимом для функции adjust:

-- | Список соседей курсора, ассоциированный с соответствующими направлениями neigbours :: Grid a -> [(Dir, a)] neigbours (Grid _ m) =    [(L, l),(R, r), (D, cursor d), (U, cursor u)]   where     (u,d) = viscinity m     (l,r) = viscinity $ cursor m

Обе описанные нами структуры Tape  и  Grid  являются комонадами. С точки зрения программиста, это некий интерфейс, относящийся к типу данных, который позволяет локальную функцию превратить в глобальную, то есть в преобразователь всей структуры по единому локальному правилу.

Реализуя этот интерфейс для произвольной структуры, достаточно определить две функции: extract и duplicate c такими типами:

class Functor w => Comonad w where   extract :: w a -> a   duplicate :: w a -> w (w a)  class Functor f where   fmap :: (a -> b) -> f a -> f b

Здесь Functor можно тоже воспринимать, как интерфейс, позволяющий применять ко всем элементам структуры некоторый преобразователь. Вот как типы Tape и Grid реализуют класс Comonad:

deriving instance Functor Tape deriving instance Functor Grid  instance Comonad Tape where   extract = cursor   duplicate = iterateT back forw  instance Comonad Grid where   extract (Grid _ g) = cursor $ cursor g   duplicate (Grid p g) =     fmap (Grid p) $ Grid p $ shift $ shift g     where       shift = iterateT (fmap back) (fmap forw)  -- | Итеративный конструктор ленты iterateT :: (a -> a) -> (a -> a) -> a -> Tape a iterateT l r x =   Tape (iterate l (l x)) x (iterate r (r x))

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

(<<=) :: (w a -> a) -> w a -> w a

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

-- | Комонадический вариант функции adjust adjustG :: Grid State -> State adjustG x = adjust (extract x) (neigbours x)

Если мы создадим пустое поле m с единственной определённой клеткой лабиринта и вычислим выражение adjustG <<= m то увидим, что клетки окружающие фиксированную ячейку стали менее неопределёнными.

Цифры показывают количество состояний в ячейках. Повторное применение преобразователя увеличивает распространение информации о фиксированной ячейке по полю.

Впрочем, это не значит, что все программы на чистом ФП обречены на детерминизм. Генераторы псевдослучайных чисел работают, используя внутреннее состояние и изменяя его. Мы можем один раз передать генератор g при вызове всей программы, а внутри неë использовать его, получая пару (g', x). В этой паре x это псевдослучайное число, а g' — генератор в новом состоянии, вычисленном на основе исходного. Ели нам потребуется не одно, а несколько случайных чисел, обновляемые генераторы можно передавать по цепочке вычислений.

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

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

Взглянем ещё раз на функцию collapse:

-- | Стохастическая часть алгоритма для одной ячейки collapse :: Rational -> State -> Random State collapse p = \case {-1-} [x]   -> return [x] {-2-} []    -> do x <- uniform states                   fromList [([x], p), ([], 1)] {-3-} state -> do x <- uniform state                   return [x]

Здесь используется конструкция do и левая стрелка <- , которыми в Haskell синтаксически оформляются монадические вычисления. Функция uniform для списка значений возвращает одно, но «завёрнутое» в контекст случайности. Далее с этим случайным значением можно производить любые операции, как с нормальной величиной, но при этом мы должны понимать, что результаты уже не смогут просто так избавиться от контекста непредсказуемости.

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

• Частичные или опциональные значения;

• вычисления с ошибками или исключениями;

• недерминированные вычисления в которых величины могут принимать несколько значений (генераторы списков);

• вычисления с внешней базой данных или с записью в лог или журнал;

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

Подобно комонаде, монады определяются неким интерфейсом: классом Monad. Этот интерфейс может быть реализован определением двух операций  return  и  join с такими типами:

-- монада return :: a -> m a join :: m (m a) -> m a

Сравните эти три операции с типами операций, определяющих комонаду:

-- комонада extract :: w a -> a duplicate :: w a -> w (w a)

Вы можете увидеть определённую симметрию в этих определениях, а именно — они двойственны друг другу. Эта двойственность и объясняет странноватые термины с приставкой «ко‑».

Определив, что некоторый тип данных является монадой (для Random, к счастью, это уже сделано), мы получаем множество полезных функций, позволяющих соединять вычисления в цепочки, сохраняющие контекст. Вот две из них, которые нам понадобятся:

(=<<) :: (a -> m a) -> m a -> m a mapM  :: (a -> m b) -> [a] -> m [a]

Первая, двойственная оператору (<<=), превращает действие над элементом монадической структуры в действие над всей структурой, а вторая (её тип я сильно упростил) позволяет применить монадическое действие к элементам списка, получив список результатов, но уже в монаде.

Нам осталось только превратить локальную монадическую функцию collapse в глобальную, и собрать монадические и комонадические вычисления в один генератор лабиринтов:

-- | Монадический вариант функции collapse collapseM :: Rational -> Maze -> Random Maze collapseM p = mapM $ mapM (collapse p)  -- | Генератор случайного лабиринта buildMaze :: Int  -- ^ Размеры лабиринта            -> Int  -- ^ Количество итераций            -> Int  -- ^ Глубина рекурсии           -> IO Maze buildMaze size n k =   evalRandIO $ do c <- uniform states                   build [[[c]]]   where     build x = iterate (stepM =<<) (return x) !! n     recur x = iterate (stepW <<=) (toGrid x) !! k     stepM x = collapseM p $ toMaze $ recur x     stepW x = adjust (extract x) (nonempty $ neigbours x)     nonempty = filter (not . null . snd)     p = 1/fromIntegral (size^2)     toGrid = grid []     toMaze = takeG size

Функция  buildMaze  принимает три параметра: размер лабиринта, количество шагов генерации и глубину рекурсии при схлопывании состояний, за это отвечает число итераций в комонаде.

На каждом шаге генерации мы погружаем поле состояний лабиринта в комонаду Grid, производим вычисления в ней, после чего передаëм поле обновлённых состояний в монаду Random. Результатом этого шага будет новый случайный лабиринт. Для многократного повторения вычислений мы пользуемся операторами (<<=) и (=<<). Функция evalRandomIO запускает вычисления с системной затравкой для ГПСЧ и погружает результат в монаду IO, в которой происходит ввод/вывод и прочее взаимодействие чистой функциональной программы с внешним миром.

В зависимости от параметров генерации мы будем получать лабиринты разной морфологии и древообразности.

Шалость удалась! Генерация лабиринта размером 100×100 занимает на моём ноутбуке от 600 мсек до 2.5 сек в зависимости от глубины рекурсии, что, в общем, вполне неплохо, учитывая, что лабиринт обычно генерируется один раз, а потом либо достраивается, либо используется как есть.

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

Решаем лабиринт

Лабиринт мы запутали монадами и комонадами, а чем бы таким помудрëнее его распутать? Предлагаю для этого воспользоваться другой парой взаимно двойственных инструментов: анаморфизмом и катаморфизмом (как вы поняли, я люблю двойственность). А заодно, можно продемонстрировать, как организуются вычисления с изменяемым состоянием в языке программирования, в котором это запрещено в принципе.

В прошлой части мы только создавали лабиринты, не заботясь об их дальнейшем использовании. Для перемещений по лабиринту и размещения в нём приманок, нам потребуется дополнительный инструментарий. В дополнение к написанному я добавил ряд полезных функций. В-первых, лабиринт надо сделать «плоским», а не собранным из квадратных ячеек:

-- | Разбивает лабиринт на набор отдельных клеток flatten :: Maze -> Grid Int flatten = grid 1 . foldMap mkRow   where     mkRow =       map concat . transpose .       map \case [(a,b,c,d)] -> [[a,b],[c,d]]                 _           -> [[1,1],[1,1]]

Кроме того, нам нужна навигация:

-- | Смещает курсор в указанном направлении move :: Int -> Dir -> Grid a -> Grid a move n dir (Grid (a,b) g) =   Grid p' $ iterate go g !! n   where     (p', go) = case dir of       D -> ((a, b+n), forw)       U -> ((a, b-n), back)       R -> ((a+n, b), fmap forw)       L -> ((a-n, b), fmap back)  -- | Смещает курсор в указанную позицию moveTo (a, b) = move (abs a) x . move (abs b) y   where     x = if a > 0 then R else L     y = if b > 0 then D else U  -- | Устанавливает значение курсора set :: a -> Grid a -> Grid a set x g = Grid p (Tape u (Tape l x r) d)   where Grid p (Tape u (Tape l _ r) d) = g  -- | Устанавливает значение курсора в указанных координатах setAt :: (Int, Int) -> a -> Grid a -> Grid a setAt p x = rewind . set x . moveTo p  -- | Возвращает курсор в начальное положение rewind :: Grid a -> Grid a rewind m = moveTo (-a,-b) m   where (a,b) = pos m

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

Задумка такая. Мы превратим лабиринт в дерево, а потом свернëм его так, чтобы оно превратилось в список путей, ведущих к приманке. Среди них можно отыскивать кратчайший, или те, что по пути собирают разложенные нами ценности или избегают опасности. В общем, полезная штука для анализа.

Дерево мы возьмём стандартное, из библиотеки Data.Tree. Оно имеет структуру «розового куста», в котором из узла выходит целый список веток, произвольной длины, список может быть пустым, а может быть и бесконечным.

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

Содержательная математическая структура не должна быть просто множеством элементов. Она задаëтся конечным набором правил и базовых примитивов, из которых строятся элементы. Полезных примеров структур, к которым применимо использование анаморфизмов, много:

• Индуктивные множества и структуры данных: натуральные числа, списки (ряды, последовательности), деревья и т. п.

• Формальные языки, описываемые порождающими грамматиками;

• Марковские цепи и генеративные сети,

• Наконец, комонады, упомянутые выше.

Как видите, в этот широкий класс структур входит много чего полезного.

Мы будем строить дерево. Для библиотечных деревьев есть функция unfoldTree с таким типом:

unfoldTree :: (b -> (a, [b])) -> b -> Tree a

Первый аргумент это порождающая функция, которая для некоторого объекта-генератора b строит узел дерева типа a, и список новых генераторов. Задача анаморфизма unfoldTree превратить генератор в целое дерево. При этом порождающая функция может быть не рекурсивной, всю машинерию и стратегию построения дерева (в ширину или в глубину) берëт на себя анаморфическая функция.

Поиск иголки в стоге сена лучше всего организовывать методом обхода стога в ширину, снимая слой за слоем. К счастью, именно этой стратегии и придерживается unfoldTree. Вот как будет строиться наше дерево:

-- | Анаморфизм лабиринта в дерево путей mkTree' :: Grid Int -> Tree ([Dir], Int) mkTree' m = unfoldTree step (m, [], empty)  step (m, ds, visited) =   let res = [ (m', d':ds, insert (pos m) visited)             | (d', n) <- neigbours m             , n /= 1             , let m' = move 1 d' m             , notMember (pos m') visited ]   in ((ds, extract m), res)

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

Штрих в названии функции говорит оом, что использовать еë мы не собираемся. Это верное, но плохое решение. Дело в том, что учёт посещённых ячеек лабиринта каждая ветка ведёт сама по себе, не советуясь с остальными. Даже на умеренно больших лабиринтах это может привести к комбинаторному взрыву и практическому зависанию программы. Значит, надо как-то сделать множество посещённых клеток общим.

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

-- | Монадический анаморфизм лабиринта в дерево путей mkTree :: Grid Int -> Tree ([Dir], Int) mkTree m = unfoldTreeM_BF stepM (m, []) `evalState` empty  stepM (m, ds) = do   visited <- get  -- ^ получаем множество посещённых позиций из контекста   let res = [ (m', d':ds)             | (d', n) <- neigbours m             , n /= 1             , let m' = move 1 d' m             , notMember (pos m') visited ]   modify $ insert (pos m)  -- ^ добавляем текущую позицию в контекст   return ((ds, extract m), res)

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

Теперь можно строить деревья обхода для достаточно больших лабиринтов. Но что нам делать с этими деревьями? Если анаморфизм отображал малое в большое, то двойственный ему катаморфизм большую структуру сворачивает в примитив. Классический пример: суммирование элементов списка чисел превращает сложную структуру (список) в простое число. Также ведут себя вычисление максимума, подсчёт количества элементов, поиск конкретного элемента и так далее. Катаморфизм иначе называют свëрткой.

Приведу один яркий, и хорошо всём знакомый пример катаморфизма и двойственного ему анаморфизма — это позиционная запись чисел. Число можно рассматривать, как примитивную структуру, вещь в себе, тогда как его представление числа в виде списка цифр в заданной системе счисления — это элемент более сложного порядка: модуля над кольцом вычетов, который мы привычно представляем упорядоченным списком цифр. Вот две функции, переводящие целое число в цифры (в порядке, обратном привычному) и наоборот:

toDigits :: Int -> Int -> [Int] toDigits base = unfoldr step   where     step n = case divMod n base of       (0, 0) -> Nothing       (r, q) -> Just (q, r)  fromDigits :: Int -> [Int] -> Int fromDigits base = foldr (\d n -> d + base*n) 0

Но вернёмся к нашим деревьям. Как и для чего нам надо будет их сворачивать? Здесь я мельком упомяну ещё одну математическую концепцию, которая очень помогает в функциональном программировании — полугруппу с единицей или моноид.

Это множество (тип данных), на котором определена некоторая ассоциативная операция (<>) и нейтральный элемент (единица, или mempty). Ассоциативность даëт нам возможность не задумываться о порядке вычислений (но не о порядке операндов), а сосредоточиться на формулировке задачи, решаемой вычислениями. Более того, мы можем определить некий универсальный катаморфизм из сложной структуры в простой моноид и с его помощью решать разные задачи, адресуя их типам ожидаемого результата. Вот что имеется в виду.

Рассмотрим список чисел. Используя универсальный катаморфизм foldMap и различные типы-моноиды мы можем найти ряд его характеристик:

λ> a = [2,3,1,5,13,2,6,8,4] :: [Int] λ> foldMap Sum a Sum {getSum = 44} λ> foldMap Product a Product {getProduct = 149760} λ> foldMap Min a Min {getMin = 1} λ> foldMap (Any . odd) a Any {getAny = True} λ> foldMap (First . (\x -> if odd x then Just x else Nothing)) a First {getFirst = Just 3} λ> foldMap (Last . (\x -> if odd x then Just x else Nothing)) a Last {getLast = Just 13}

Сами типы Sum, Product, Min, Any, First и Last ничего не вычисляют. Они только помечают числа, обозначая в каком моноиде мы производим свёртку. Конкретная операция определена в реализациях классов Semigroup и Monoid для этих типов. Точно такой же принцип мы можем использовать и для нашего дерева. Вот как можно добывать из нашего дерева пути до цели:

-- | Выделение поддерева путей к указанной цели pathTo :: Int -> Grid Int -> Tree (Maybe [Dir]) pathTo s =   fmap (\(p, x) -> if x == s then Just p else Nothing) . mkTree  -- | Катаморфизм дерева в список путей (моноид []) allPaths :: Int -> Grid Int -> [[Dir]] allPaths s = foldMap maybeToList . pathTo s  -- | Катаморфизм дерева в первый найденный путь (моноид First) firstPath :: Int -> Grid Int -> Maybe [Dir] firstPath s = getFirst . foldMap First . pathTo s

Определив вспомогательный тип Path для путей в лабиринте, и отношение порядка для путей, мы можем выделить кратчайший путь:

newtype Path = Path {getPath :: [Dir]}   deriving (Eq, Show)  instance Ord Path where   compare (Path a) (Path b) = comparing length a b  -- | Катаморфизм дерева в кратчайший путь (моноид Min) shortestPath :: Int -> Grid Int -> Maybe [Dir] shortestPath s =    fmap (getPath . getMin) . foldMap (Min . Path <$>) . pathTo s

Впрочем, использование построение дерева стратегией поиска в ширину приводит к тому, что скорее всего, firstPath вернёт один из минимальных путей по длине.

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

markPath :: Int -> Grid Int -> [Dir] -> Grid Int markPath x m =   rewind . foldr (\d -> move 1 d . set x) m

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

main = do   maze <- flatten <$> buildMaze n 400 1   let m = set 0 $ moveTo (-1,0) $ setAt (2*n-1,2*n-1) 2 maze       path = fromMaybe [] $ firstPath 2 m       m' = moveTo (-1,-1) $ markPath 3 m path   mapM_ (putStrLn . concat) $ takeG (2*n+2) $ toChar m'   where     n = 12     toChar = fmap \case       1 -> "░░"       2 -> "\ESC[93m██\ESC[0m"       3 -> "\ESC[31m**\ESC[0m"       _ -> "  "

Весь проект можно посмотреть и скачать в репозитории https://hub.darcs.net/samsergey/maze