Last active
November 18, 2015 14:15
-
-
Save hakelimopu/d335c3c36bd26ab7b71a to your computer and use it in GitHub Desktop.
A lot of gyrations and convolutions on the way here, but I got it to generate a maze via Prim's algorithm.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
type Direction = North | East | South | West | |
let DirectionDelta = function | |
| North -> 0, -1 | |
| East -> 1, 0 | |
| South -> 0, 1 | |
| West -> -1, 0 | |
let DirectionOpposite = function | |
| North -> South | |
| East -> West | |
| South -> North | |
| West -> East | |
let DirectionFlag = function | |
| North -> 1 | |
| East -> 2 | |
| South -> 4 | |
| West -> 8 | |
let Walk start direction = | |
let startX, startY = start | |
let deltaX, deltaY = DirectionDelta direction | |
(startX + deltaX, startY + deltaY) | |
type Location = {X: int; Y: int} | |
type Cell = {Location: Location; UnconnectedNeighbors: Set<Direction>; ConnectedNeighbors: Set<Direction> } | |
let FindNeighbors (cells: Cell list) (cell: Cell) = | |
[North; East; South; West] | |
|> List.map (fun direction -> | |
let nextX, nextY = Walk (cell.Location.X, cell.Location.Y) direction | |
(direction, { X = nextX; Y = nextY } )) | |
|> List.map (fun location -> | |
cells | |
|> List.choose (fun c -> | |
let d,l = location | |
if c.Location = l then Some d else None) | |
) | |
|> List.reduce (@) | |
|> Set.ofList | |
let MakeCells width height = | |
let cells = | |
[0..width-1] | |
|> List.map (fun x-> | |
[0..height-1] | |
|> List.map (fun y-> { Location = {X = x; Y = y}; UnconnectedNeighbors = Set.empty; ConnectedNeighbors = Set.empty})) | |
|> List.reduce (@) | |
cells | |
|> List.map (fun cell -> | |
{ Location = cell.Location; ConnectedNeighbors=Set.empty; UnconnectedNeighbors = FindNeighbors cells cell}) | |
let IsComplete (cells: Cell list) = | |
cells | |
|> List.exists (fun c -> c.ConnectedNeighbors.IsEmpty) | |
|> not | |
let IsBlank (cells: Cell list) = | |
cells | |
|> List.filter (fun c-> not c.ConnectedNeighbors.IsEmpty) | |
|> List.isEmpty | |
let StartMaze (cells: Cell list) = | |
let originalCell = cells |> List.sortBy(fun e-> System.Guid.NewGuid()) |> List.head | |
let originalLocation = originalCell.Location | |
let nextDirection = originalCell.UnconnectedNeighbors|> Set.toList |> List.sortBy(fun e-> System.Guid.NewGuid()) |> List.head | |
let nextLocation = let nextX, nextY = nextDirection |> Walk (originalLocation.X, originalLocation.Y) | |
{ X = nextX; Y = nextY} | |
let nextCell = cells |> List.find(fun e->e.Location=nextLocation) | |
let otherCells = cells |> List.filter(fun e-> e <> originalCell && e <> nextCell) | |
let newOriginalCell = { | |
Location = originalCell.Location; | |
ConnectedNeighbors = originalCell.ConnectedNeighbors |> Set.add nextDirection; | |
UnconnectedNeighbors = originalCell.UnconnectedNeighbors |> Set.remove nextDirection} | |
let newNextCell = { | |
Location = nextCell.Location; | |
ConnectedNeighbors = nextCell.ConnectedNeighbors |> Set.add (nextDirection |> DirectionOpposite); | |
UnconnectedNeighbors = nextCell.UnconnectedNeighbors |> Set.remove (nextDirection |> DirectionOpposite) } | |
newOriginalCell :: (newNextCell :: otherCells) | |
let AddRoom (cells: Cell list) = | |
let connectedLocations = cells | |
|> List.filter (fun e-> not e.ConnectedNeighbors.IsEmpty) | |
|> List.map (fun e->e.Location) | |
|> Set.ofList | |
let frontierCells = cells | |
|> List.filter (fun unconnectedRoom->unconnectedRoom.ConnectedNeighbors.IsEmpty) | |
|> List.filter (fun unconnectedRoom-> | |
let neighbors = unconnectedRoom.UnconnectedNeighbors |> Set.map( | |
fun elem-> | |
let neighborX, neighborY = Walk (unconnectedRoom.Location.X, unconnectedRoom.Location.Y) elem | |
{X = neighborX; Y = neighborY}) | |
Set.intersect neighbors connectedLocations | |
|> Set.isEmpty |> not) | |
let frontierCell = frontierCells |> List.sortBy (fun e->System.Guid.NewGuid()) |> List.head | |
let frontierLocation = frontierCell.Location | |
let nextDirection, nextLocation = | |
let neighbors = frontierCell.UnconnectedNeighbors |> Set.map( | |
fun elem-> | |
let neighborX, neighborY = Walk (frontierCell.Location.X, frontierCell.Location.Y) elem | |
(elem, {X = neighborX; Y = neighborY})) | |
neighbors |> Set.filter (fun elem-> | |
let d, l = elem | |
connectedLocations.Contains(l) | |
) | |
|> Set.toList | |
|> List.sortBy(fun e->System.Guid.NewGuid()) | |
|> List.head | |
let nextCell = cells |> List.find(fun e->e.Location=nextLocation) | |
let otherCells = cells |> List.filter(fun e-> e <> frontierCell && e <> nextCell) | |
let newOriginalCell = { | |
Location = frontierCell.Location; | |
ConnectedNeighbors = frontierCell.ConnectedNeighbors |> Set.add nextDirection; | |
UnconnectedNeighbors = frontierCell.UnconnectedNeighbors |> Set.remove nextDirection} | |
let newNextCell = { | |
Location = nextCell.Location; | |
ConnectedNeighbors = nextCell.ConnectedNeighbors |> Set.add (nextDirection |> DirectionOpposite); | |
UnconnectedNeighbors = nextCell.UnconnectedNeighbors |> Set.remove (nextDirection |> DirectionOpposite) } | |
newOriginalCell :: (newNextCell :: otherCells) | |
let (|Completed|Empty|UnderConstruction|) cells = | |
if cells |> IsComplete then Completed | |
elif cells |> IsBlank then Empty | |
else UnderConstruction | |
let rec MakeMaze (cells: Cell list) = | |
match cells with | |
| Completed -> cells | |
| Empty -> cells |> StartMaze |> MakeMaze | |
| _ -> cells |> AddRoom |> MakeMaze | |
type MazeNode = { Location: Location; Connections: Set<Direction>} | |
let CellToMazeNode (cell: Cell) = | |
{Location = cell.Location; Connections= cell.ConnectedNeighbors} | |
let GenerateMaze columns rows = MakeCells columns rows | |
|> MakeMaze | |
|> List.map (fun elem -> elem |> CellToMazeNode) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment