Генератор лабиринтов на Haskell
24 августа 2011
В ходе экспериментов с функциональным программированием я решил написать генератор лабиринтов. Приведенный код не претендует на элегантность или возможность практического применения где-то, кроме как в компьютерных играх. Тем не менее, для людей, постоянно занимающихся прокачкой своего умения программировать, этот пост может быть весьма полезен.
Далее большую часть заметки я буду приводить отрывки кода и комментировать их. Скачать полную версию кода можно здесь.
Генератор лабиринтов я с сразу начал писать в виде модуля. Как и любой другой уважающий себя модуль на языке Haskell, он начинается с названия и списка экспортируемых сущностей. Ну и копирайтов, естественно:
-- Maze.Generator v 0.1
-- (c) Alexandr A Alexeev 2011 | http://eax.me/
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 ++ "\x2588" ++ showBool r,
" " ++ showBool b ++ " "
]
where
showBool True = "\x2588" -- unicode-символ "черный пробел"
showBool _ = " "
Зачем она нужна, становится понятно из идущего следом кода:
-- экземпляр класса Show для клетки лабиринта
instance Show Directions where
show d =
concatMap (++ "\n") $ cellView d
В случае с типом Directions мы просто дописываем символ новой строки к конец каждого элемента списка, возвращаемого функцией cellView, а затем объединяем эти элементы в одну строку. В случае с типом Maze все немного сложнее:
-- экземпляр класса Show для лабиринта
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».
Далее я написал несколько вспомогательных функций. Первая предназначена для создания «пустого» лабиринта. Возможно, тут имя функции не совсем отражает ее суть. Интуитивно под «пустым» лабиринтом мы понимаем лабиринт без стен, то есть в каждой клетке которого разрешено движение в любом из четырех направлений. Однако приведенная ниже функция делает все с точностью до наоборот:
-- создаем лабиринт размером w x h, где запрещено любое движение
emptyMaze w h = Maze $ map
(map (\x -> Directions False False False False))
[x | x <- [[1..w]], t <- [1..h]]
То есть под «пустым» лабиринтом тут следует понимать кусок скалы, в котором еще предстоит прорыть тоннели, тем самым «заполнив» лабиринт. Не знаю — возможно, следовало бы подыскать более удачное имя для этой функции.
Следующая функция создает список с координатами всех клеток, принадлежащих лабиринту. Опять таки, возможно, тут следовало бы воспользоваться каким-нибудь модулем, экспортирующим тип Point, но мне на данный момент такое решение показалось проще:
-- получить координаты всех клеток лабиринта размером w x h
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)’го элемента в матрице и условие выхода из рекурсии.
Следующая функция генерирует список всех возможных путей заданной длины из заданной клетки:
-- генерируем все возможные пути длиной _ровно_ pathLen
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, но более простого решения мне найти не удалось.
Еще нам понадобится функция генерации всех путей из заданной точки длины не более заданной:
-- генерируем все возможные пути из startCell длиной _до_ maxLen
genAllPathsFrom startCell freeCells maxLen = foldl (++) [] [
genPathsFrom startCell (filter(/= startCell) freeCells) pathLen
| pathLen <- [2..maxLen]
]
Наконец, мы почти добрались собственно до функции генерации лабиринтов. Сначала я написал функцию, которая генерировала вообще все возможные лабиринты. Ее проблема была в том, что многие генерируемые лабиринты были слишком простыми. То есть, они состояли из «змеек» или «лесенок» с небольшим количеством «развилок». Для генерации же сложных лабиринтов требовалось неизвестно как много времени. Хотя множества небольших лабиринтов (размером 44 или даже 55) генерировались довольно быстро.
Оставался открытым вопрос, как генерировать большие и при этом сложные лабиринты? Почему-то в первую очередь вспомнились фракталы. Идея была в том, чтобы сделать лабиринт размером 44, а затем каждую его клетку map’нуть в еще один лабиринт размером 44, после чего связать все лабиринты и получить один большой лабиринт размером 1616. А затем 6464, 256256 и так далее. Однако эту идею я отверг из-за сложности (вспомнилась связка map и foldl) и малой гибкости (ведь еще бывают лабиринты 4532 и прочих размеров).
Другая идея заключалась в том, чтобы не перебирать все возможные варианты лабиринтов, а создавать один, выбирая на каждом шаге рекурсии в генерирующей функции случайное «направление». Собственно, как-то так лабиринты и генерируются в императивных языках. Только придется сделать собственную реализацию генератора псевдослучайных чисел, чтобы функция создания лабиринта оставалась чистой.
В итоге я написал следующую функцию:
-- генерируем случайный лабиринт размером w x h для заданного randSeed
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. Что интересно, немного изменив программу, мы фактически получим математическое определение лабиринта в стиле «множеством лабиринтов WH называется множество таких матриц WH4, для которых …». При этом в определении будут использованы только такие простые математические понятия, как множество, матрица, вектор или кортеж.
Дополнение: См также генератор лабиринтов на OCaml.
Понравился пост? Поделитесь с другими:
