A Second, Better Approach to Immutable Maze Generation

Cardinal.fs

module Cardinal

open Location

type Direction = North | East | South | West

let Walk (location:Location) (direction:Direction) : Location = 
    match direction with
    | North -> {location with                          Row=location.Row-1}
    | East  -> {location with Column=location.Column+1                   }
    | South -> {location with                          Row=location.Row+1}
    | West  -> {location with Column=location.Column-1                   }

let Values = [North; East; South; West]

ColumnHex.fs

module ColumnHex

open Location

type Direction = North | Northeast | Southeast | South | Southwest | Northwest

let Walk (location:Location) (direction:Direction) : Location = 
    match direction with
    | North     -> {location with                               Row = location.Row - 1}
    | Northeast -> {location with Column = location.Column + 1                        }
    | Southeast -> {              Column = location.Column + 1; Row = location.Row + 1}
    | South     -> {location with                               Row = location.Row + 1}
    | Southwest -> {location with Column = location.Column - 1                        }
    | Northwest -> {              Column = location.Column - 1; Row = location.Row - 1}

let Values = [North; Northeast; Southeast; South; Southwest; Northwest]

Intercardinal.fs

module Intercardinal

open Location

type Direction = North | Northeast | East | Southeast | South | Southwest | West | Northwest

let Walk (location:Location) (direction:Direction) : Location = 
    match direction with
    | North     -> {location with                               Row = location.Row - 1}
    | Northeast -> {              Column = location.Column + 1; Row = location.Row - 1}
    | East      -> {location with Column = location.Column + 1                        }
    | Southeast -> {              Column = location.Column + 1; Row = location.Row + 1}
    | South     -> {location with                               Row = location.Row + 1}
    | Southwest -> {              Column = location.Column - 1; Row = location.Row + 1}
    | West      -> {location with Column = location.Column - 1                        }
    | Northwest -> {              Column = location.Column - 1; Row = location.Row - 1}

let Values = [North; Northeast; East; Southeast; South; Southwest; West; Northwest]

Location.fs

module Location

type Location = {Column: int; Row: int}

Neighbors.fs

module Neighbors

open Location

let FindAll (walk: Location->'direction->Location) (directions:'direction list) (location:Location) : Location list =
    directions
    |> List.map(walk location)
    

let FindAllCardinal = FindAll Cardinal.Walk Cardinal.Values
let FindAllIntercardinal = FindAll Intercardinal.Walk Intercardinal.Values
let FindAllRowHex = FindAll RowHex.Walk RowHex.Values
let FindAllColumnHex = FindAll ColumnHex.Walk ColumnHex.Values

Program.fs

open Location
open Neighbors

let MakeGrid (columns, rows) = 
    [for c in [0..columns-1] do
        for r in [0..rows-1] do
            yield {Column=c; Row=r}]

let MakeEmptyMaze (locations: Location list) =
    locations
    |> List.map(fun item -> (item, Set.empty))
    |> Map.ofSeq

let AddConnection (fromLocation: Location) (toLocation:Location) (maze: Map<Location, Set<Location> >) =
    let newConnections = maze.[fromLocation]
                         |> Set.add toLocation
    maze
    |> Map.add fromLocation newConnections

let AddConnections (fromLocation: Location) (toLocation:Location) (maze: Map<Location, Set<Location> >) =
    maze
    |> AddConnection fromLocation toLocation
    |> AddConnection toLocation fromLocation

let ChooseStart (condition:Location->bool) (maze: Map<Location, Set<Location> >) =
    maze 
    |> Map.toSeq
    |> Seq.map (fun (k,v) -> k)
    |> Seq.filter(condition)
    |> Seq.sortBy (fun e-> System.Guid.NewGuid()) 
    |> Seq.head

let ChooseNeighbor (neighborFinder:Location -> Location list) (maze: Map<Location, Set<Location> >) (location: Location) =
    location
    |> neighborFinder
    |> Seq.filter (fun e-> maze.ContainsKey(e))
    |> Seq.sortBy (fun e-> System.Guid.NewGuid()) 
    |> Seq.head
    

let StartMaze (neighborFinder:Location -> Location list) (maze: Map<Location, Set<Location> >) =
    let start = 
        maze 
        |> ChooseStart (fun e-> true)
    let neighbor =
        start
        |> ChooseNeighbor neighborFinder maze
    maze
    |> AddConnections start neighbor


let GetPossibleConnections (neighborFinder:Location -> Location list) (maze: Map<Location, Set<Location> >) (location:Location) =
    location
    |> neighborFinder
    |> List.filter (fun e-> maze.ContainsKey(e))

let CanConnectTo (neighborFinder:Location -> Location list) (maze: Map<Location, Set<Location> >) (location:Location)=
    location
    |> GetPossibleConnections neighborFinder maze
    |> List.isEmpty
    |> not

let AddRoom (neighborFinder:Location -> Location list) (maze: Map<Location, Set<Location> >) =
    let outside, inside = 
        maze 
        |> Map.partition (fun k v -> v.IsEmpty)
    let start = 
        outside 
        |> ChooseStart (fun e-> e |> CanConnectTo neighborFinder inside)
    let neighbor =
        start
        |> ChooseNeighbor neighborFinder inside
    maze
    |> AddConnections start neighbor

let (|Complete|InProgress|Empty|) (maze: Map<Location, Set<Location> >) =
    let outside, inside = maze |> Map.partition (fun k v -> v.IsEmpty)
    if inside.IsEmpty then
        Empty
    elif outside.IsEmpty then
        Complete
    else
        InProgress

let rec MakeMaze (neighborFinder:Location -> Location list) maze =
    match maze with
    | Complete -> maze
    | Empty -> maze |> StartMaze neighborFinder |> MakeMaze neighborFinder
    | _ -> maze |> AddRoom neighborFinder |> MakeMaze neighborFinder

[<EntryPoint>]
let main argv = 
    let maze = 
        (2,2)
        |> MakeGrid
        |> MakeEmptyMaze
        |> MakeMaze FindAllCardinal
        |> Map.toSeq
        |> printfn "%A"
    0

RowHex.fs

module RowHex

open Location

type Direction = Northeast | East | Southeast | Southwest | West | Northwest

let Walk (location:Location) (direction:Direction) : Location = 
    match direction with
    | Northeast -> {location with                               Row = location.Row - 1}
    | East      -> {location with Column = location.Column + 1                        }
    | Southeast -> {              Column = location.Column + 1; Row = location.Row + 1}
    | Southwest -> {location with                               Row = location.Row + 1}
    | West      -> {location with Column = location.Column - 1                        }
    | Northwest -> {              Column = location.Column - 1; Row = location.Row - 1}

let Values = [Northeast; East; Southeast; Southwest; West; Northwest]

Naturally, the Gist screws up the order:

The order it needs to go in:

Location.fs
//the next four's order doesn't really matter. but depend on Location
Cardinal.fs
Intercardinal.fs
RowHex.fs
ColumnHex.fs
//neighbors depends on the previous four
Neighbors.fs
Program.fs