В ходе экспериментов с функциональным программированием я решил написать генератор лабиринтов. Приведенный код не претендует на элегантность или возможность практического применения где-то, кроме как в компьютерных играх. Тем не менее, для людей, постоянно занимающихся прокачкой своего умения программировать, этот пост может быть весьма полезен.
Далее б о льшую часть заметки я буду приводить отрывки кода и комментировать их. Скачать полную версию кода можно здесь .
Генератор лабиринтов я с сразу начал писать в виде модуля. Как и любой другой уважающий себя модуль на языке Haskell , он начинается с названия и списка экспортируемых сущностей. Ну и копирайтов, естественно:
— (c) Alexandr A Alexeev 2011 | http://remontka.com/
module Maze . Generator (
Maze , — абстрактный тип данных «лабиринт»
genMaze — функция генерации лабиринтов
) where
Далее подключается модуль Data.List. Он содержит полезные функции и операторы для работы со списками. В частности, нам понадобится функция intersect и оператор (\).
Лабиринт — это по сути плоскость, поделенная на клеточки. Мы можем перемещаться по плоскости, попадая из одного клеточки в другую. Однако на каждом шаге мы можем двигаться только в определенных направлениях, которые зависят от того, в какой клетке мы находимся. То есть, имеет место запрет на «хождение сквозь стены». Введем тип данных, представляющий собой возможные направления движения:
data Directions =
Directions { top :: Bool , right :: Bool , bottom :: Bool , left :: Bool }
Соответственно, лабиринт — это двумерный список из Directions. Наверное, тут можно было воспользоваться каким-нибудь модулем для работы с матрицами. Однако мне, как человеку, недавно начавшего программировать на Haskell, пока что проще использовать двумерные списки:
data Maze = Maze [ [ Directions ] ]
Чтобы код было проще отлаживать, я решил сразу объявить экземпляры класса Show для типов Maze и Directions (не путать классы в Haskell с классами в C++ и Java!). Для начала я объявил небольшую вспомогательную функцию:
cellView ( Directions t r b l ) =
[ » » ++ showBool t ++ » » ,
showBool l ++ » x 2588″ ++ showBool r ,
» » ++ showBool b ++ » »
]
where
showBool True = » x 2588″ — unicode-символ «черный пробел»
showBool _ = » »
Зачем она нужна, становится понятно из идущего следом кода:
instance Show Directions where
show d =
concatMap ( ++ » n » ) $ cellView d
В случае с типом Directions мы просто дописываем символ новой строки к конец каждого элемента списка, возвращаемого функцией cellView, а затем объединяем эти элементы в одну строку. В случае с типом Maze все немного сложнее:
instance Show Maze where
show ( Maze m ) = concatMap ( concatMap ( ++ » n » ) ) lines
where
lines = map ( ( map ( foldl ( ++ ) [ ] ) ) . transpose ) viewMatrix
viewMatrix = map ( map cellView ) m
Здесь viewMatrix — это матрица (точнее — двумерный список), элементами которой являются списки, возвращаемые функцией cellView. Затем с помощью хитрой комбинации функций map, foldl и transpose мы получаем из viewMatrix список строк. Этот список выводится точно так же, как и в случае с типом Directions. Принцип работы «хитрой комбинации» я замучаюсь объяснять в письменной форме, так что оставляю вам этот вопрос для самостоятельного изучения.
Дополнение: Уже после написания заметки до меня дошло, что вместо « foldl (++) [] » можно написать просто «concat».
Далее я написал несколько вспомогательных функций. Первая предназначена для создания «пустого» лабиринта. Возможно, тут имя функции не совсем отражает ее суть. Интуитивно под «пустым» лабиринтом мы понимаем лабиринт без стен, то есть в каждой клетке которого разрешено движение в любом из четырех направлений. Однако приведенная ниже функция делает все с точностью до наоборот:
emptyMaze w h = Maze $ map
( map ( x -> Directions False False False False ) )
[ x | x <- [ [ 1 .. w ] ] , t <- [ 1 .. h ] ]
То есть под «пустым» лабиринтом тут следует понимать кусок скалы, в котором еще предстоит прорыть тоннели, тем самым «заполнив» лабиринт. Не знаю — возможно, следовало бы подыскать более удачное имя для этой функции.
Следующая функция создает список с координатами всех клеток, принадлежащих лабиринту. Опять таки, возможно, тут следовало бы воспользоваться каким-нибудь модулем, экспортирующим тип Point, но мне на данный момент такое решение показалось проще:
genMazeCells w h
| w <= 0 || h <= 0 = [ ]
| otherwise = [ ( x , y ) | x <- [ 0 .. w — 1 ] , y <- [ 0 .. h — 1 ] ]
Следующая функция предназначена для «прорезания» пути в лабиринте. Она не сложная, но содержит много кода, который я буду приводить отрывками:
pavePath ( Maze m ) ( from:to:xs ) =
pavePath ( Maze $ matrixReplaceAt x1 y1 d1′ $
matrixReplaceAt x2 y2 d2′ m ) ( to:xs )
where
— …
Функция принимает в качестве аргументов лабиринт m и список координат клеток, представляющий собой «прорезаемый» путь. Функция рекурсивная. На каждом шаге рекурсии из списка клеток убирается один элемент, а в лабиринте изменяются две клетки, с координатами (x1, y1) и (x2, y2).
— координаты текущей и следующей клетки
( x1 , y1 , x2 , y2 ) = ( fst from , snd from , fst to , snd to )
— в каком направлении был сделан шаг?
stepTop = ( x1 == x2 ) && ( y1 — y2 == 1 )
stepBottom = ( x1 == x2 ) && ( y2 — y1 == 1 )
stepLeft = ( y1 == y2 ) && ( x1 — x2 == 1 )
stepRight = ( y1 == y2 ) && ( x2 — x1 == 1 )
— …
Тут вроде все понятно. Берем координаты первых двух точек пути и определяем направление движения.
d1 = m !! y1 !! x1 — текущая клетка
d2 = m !! y2 !! x2 — следующая клетка
— меняем возможные направления движения в текущей клетке
d1′ = Directions {
top = ( top d1 ) || stepTop , right = ( right d1 ) || stepRight ,
bottom = ( bottom d1 ) || stepBottom , left = ( left d1 ) || stepLeft
}
— меняем возможные направления движения в следующей клетке
d2′ = Directions {
top = ( top d2 ) || stepBottom , right = ( right d2 ) || stepLeft ,
bottom = ( bottom d2 ) || stepTop , left = ( left d2 ) || stepRight
}
— …
Тут вроде тоже не сложно. Если путь «прорезается» в определенном направлении, а в свойствах клетки лабиринта говорится, что туда ходить нельзя, говорим, что теперь туда ходить можно.
— замена idx’ового элемента списка lst на itm
replaceAt idx lst itm =
( ( a , _ :b ) -> a ++ [ itm ] ++ b ) $ splitAt idx lst
— замена элемента (x, y) матрицы mtrx на itm
matrixReplaceAt x y itm mtrx =
replaceAt y mtrx $ replaceAt x ( mtrx !! y ) itm
pavePath m _ = m
Тут определяется функция замены (x, y)’го элемента в матрице и условие выхода из рекурсии.
Следующая функция генерирует список всех возможных путей заданной длины из заданной клетки:
genPathsFrom currCell freeCells pathLen
| pathLen <= 1 || freeCells == [ ] = [ [ currCell ] ]
| otherwise = map ( ( : ) currCell ) $ foldl ( ++ ) [ ] [
genPathsFrom nextCell ( filter ( /= nextCell ) freeCells ) ( pathLen — 1 )
| nextCell <- freeCells , areNearby currCell nextCell
]
where
— являются ли две клетки соседними?
areNearby ( x1 , y1 ) ( x2 , y2 ) = ( abs ( x1 — x2 ) + abs ( y1 — y2 ) == 1 )
Здесь freeCells — это список клеток, куда еще можно «рыть». В функции используется довольно сложная конструкция из map и foldl, но более простого решения мне найти не удалось.
Еще нам понадобится функция генерации всех путей из заданной точки длины не более заданной:
genAllPathsFrom startCell freeCells maxLen = foldl ( ++ ) [ ] [
genPathsFrom startCell ( filter ( /= startCell ) freeCells ) pathLen
| pathLen <- [ 2 .. maxLen ]
]
Наконец, мы почти добрались собственно до функции генерации лабиринтов. Сначала я написал функцию, которая генерировала вообще все возможные лабиринты. Ее проблема была в том, что многие генерируемые лабиринты были слишком простыми. То есть, они состояли из «змеек» или «лесенок» с небольшим количеством «развилок». Для генерации же сложных лабиринтов требовалось неизвестно как много времени. Хотя множества небольших лабиринтов (размером 4×4 или даже 5×5) генерировались довольно быстро.
Оставался открытым вопрос, как генерировать большие и при этом сложные лабиринты? Почему-то в первую очередь вспомнились фракталы . Идея была в том, чтобы сделать лабиринт размером 4×4, а затем каждую его клетку map’нуть в еще один лабиринт размером 4×4, после чего связать все лабиринты и получить один большой лабиринт размером 16×16. А затем 64×64, 256×256 и так далее. Однако эту идею я отверг из-за сложности (вспомнилась связка map и foldl) и малой гибкости (ведь еще бывают лабиринты 45×32 и прочих размеров).
Другая идея заключалась в том, чтобы не перебирать все возможные варианты лабиринтов, а создавать один, выбирая на каждом шаге рекурсии в генерирующей функции случайное «направление». Собственно, как-то так лабиринты и генерируются в императивных языках. Только придется сделать собственную реализацию генератора псевдослучайных чисел , чтобы функция создания лабиринта оставалась чистой.
В итоге я написал следующую функцию:
genMaze :: Int -> Int -> Int -> Maze
genMaze w h randSeed =
genMaze’ randSeed ( emptyMaze w h ) ( genMazeCells w h \ [ ( x , y ) ] ) [ ( x , y ) ]
where
( x , y ) = ( w ` div ` 2 , h ` div ` 2 )
genMaze’ randSeed currMaze freeCells tailCells
| freeCells == [ ] = currMaze
— …
Функция genMaze представляет собой лишь оболочку вокруг рекурсивной функции genMaze’. Кстати, вот где нам пригодились функции emptyMaze и genMazeCells. Только, возможно, стоило запихнуть их в where-блок… Функция genMaze’ принимает в качестве аргументов «случайное» число, наш будущий лабиринт (аккумулирующий аргумент), список еще не «прорезанных» ячеек и список ячеек, откуда можно начинать «резать». Прокладывать пути начинаем из середины лабиринта.
| otherwise =
genMaze’ nextRandSeed
— накладываем маршрут на лабиринт
( pavePath currMaze currPath )
— свободные клетки за минусом клеток текущего маршрута
nextFreeCells
— получаем клетки, из которых можно построить маршрут
( filterDeadends $ tailCells ++ ( currPath \ [ startCell ] ) )
where
— …
На каждом шаге рекурсии мы «прорезаем» в лабиринте новый путь currPath, начинающийся в ячейке startCell.
— отсекаем ячейки, рядом с которыми нет ни одной свободной
filterDeadends =
filter ( x -> ( ( getNearby x ) `intersect` nextFreeCells ) /= [ ] )
where
getNearby ( x , y ) = [ ( x — 1 , y ) , ( x + 1 , y ) , ( x , y — 1 ) , ( x , y + 1 ) ]
— свободные ячейки на следующем шаге рекурсии
nextFreeCells = freeCells \ currPath
— …
Вроде, код говорит сам за себя.
— cлучайным образом выбираем один из маршрутов
currPath = nextPaths’ !! ( ( abs randSeed ) ` mod ` length nextPaths’ )
— в целях оптимизации рассматриваем только три первых варианта
nextPaths’ = take 3 $ nextPaths
— возможные новые маршруты длиной до трех клеток
nextPaths = genAllPathsFrom startCell freeCells 3
— …
Почему мы генерируем пути длиной до трех клеток? Почему из всех возможных вариантов берем три штуки, и только затем «случайным образом» выбираем из них один? Методом проб и ошибок было установлено, что такой код приводит к получению неплохих лабиринтов и при этом работает быстро.
— новый маршрут строим из случайно выбранной «хвостовой» клетки
startCell = tailCells !! ( ( abs nextRandSeed ) ` mod ` length tailCells )
— генерируем следующее «случайное» число
nextRandSeed = randSeed * 1664525 + 1013904223
Ну и, наконец, выбор стартовой ячейки и генерация следующего псевдослучайного числа.
Вот так выглядит один из лабиринтов, полученных с помощью описанного выше кода:
Повторюсь, особой практической ценности от самого кода я не вижу. Зато в процессе его написания я неплохо прокачал свой скил владения Haskell, да и программирования вообще. Если вы тоже качаете эти скилы, но при этом вам не интересно писать с нуля код, который уже кем-то написан, не расстраивайтесь! Попробуйте написать генератор не двумерных, а трех- или N-мерных лабиринтов. Или, например, лабиринтов, состоящего из шестиугольников, а не квадратов.
P.S. Что интересно, немного изменив программу, мы фактически получим математическое определение лабиринта в стиле «множеством лабиринтов W?H называется множество таких матриц W?H?4, для которых …». При этом в определении будут использованы только такие простые математические понятия, как множество, матрица, вектор или кортеж.
Дополнение: См также генератор лабиринтов на OCaml .
