4 people like it.
Like the snippet!
Growing Tree Algorithm for Maze Generation
There are several maze creation algorithms (http://www.astrolog.org/labyrnth/algrithm.htm). The interesting point about Growing Tree one is that it turns into the others (for example, Recursive Backtracker and Prim's algo) when we choose the next step in different ways. Check it with tryfsharp.org.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
|
let directions = [|
0, 1 // down
1, 0 // right
0, -1 // up
-1, 0 // left
|]
type CellType = Free | Wall
/// Several heuristics for choosing the next cell
type GrowMethod =
| RecursiveBacktracker
| Prim
| ChooseTheOldest
(overriden ToString())
let createMaze xMax yMax =
let maze = Array2D.create xMax yMax Wall
// Check if (x, y) are valid coordinates
let inline inMaze x y = 0 <= x && x < xMax && 0 <= y && y < yMax
// The wall at (x, y) between current cell and another can be removed
// if all it's neighbors are walls too (we leave a border of walls)
let canRemoveWall x y =
let dirs =
directions |> Array.sumBy (fun (dx, dy) ->
let x', y' = x + dx, y + dy
if inMaze x' y' && maze.[x', y'] = Wall then 1 else 0)
dirs = 3
// Check if a cell is not free yet and the wall can be removed
let getPossibleDirections (x, y) = async {
return directions |> Array.filter (fun (dx, dy) ->
let x', y' = x + dx, y + dy
inMaze x' y' && maze.[x', y'] = Wall && canRemoveWall x' y')}
maze, getPossibleDirections
let inline map f (x, y) = f x, f y
type MazeControl() as this =
inherit UserControl()
let pause() = Async.Sleep 25
let canvas = Canvas(Background = SolidColorBrush Colors.Blue)
do this.Content <- canvas
// Create a rectangle at the cell: current - red, others - white
let createRectangle (cell, current) = (...)
// Fill a cell with corresponding color
let fill = createRectangle >> canvas.Children.Add
let drawMaze xMax yMax growMethod =
(...)
let maze, getPossibleDirections = createMaze xMax yMax
// List of the cells to choose from
let cells = new ResizeArray<_>()
// To get the Recursive Backtracker we choose the most recent cell
// For Prim - the random one
// And the third one - the oldest
let chooseNext() =
let ind =
match growMethod with
| RecursiveBacktracker -> cells.Count - 1
| Prim -> rand.Next cells.Count
| _ -> 0
cells.[ind]
// Choose a start point
let sx, sy = rand.Next (1, xMax-1), rand.Next (1, yMax-1)
maze.[sx, sy] <- Free
cells.Add (sx, sy)
// Draw the maze
let rec run() = async {
if cells.Count = 0 then () // If there're no cells - finish
else
// Go to the next cell and draw it as current
let cell = chooseNext()
fill (cell, true)
do! pause()
let! possibleDirections = getPossibleDirections cell
match possibleDirections.Length with
| 0 -> cells.Remove cell |> ignore // There's no way to go - remove it
| len ->
// Randomly choose a direction
let dx, dy = possibleDirections.[rand.Next len]
let x, y = fst cell + dx, snd cell + dy
maze.[x, y] <- Free
// Add to list as a candidate for a futures growth
cells.Add (x, y)
fill (cell, false) // It's not current any more
do! run()
}
run()
/// Drawing a 21x21 maze with a specified method
member this.DrawMaze growMethod =
Async.CancelDefaultToken() // Cancel drawing of the previous maze
canvas.Children.Clear()
drawMaze 21 21 growMethod |> Async.StartImmediate
|
val directions : (int * int) []
Full name: Script.directions
type CellType =
| Free
| Wall
Full name: Script.CellType
union case CellType.Free: CellType
union case CellType.Wall: CellType
type GrowMethod =
| RecursiveBacktracker
| Prim
| ChooseTheOldest
override ToString : unit -> string
Full name: Script.GrowMethod
Several heuristics for choosing the next cell
union case GrowMethod.RecursiveBacktracker: GrowMethod
union case GrowMethod.Prim: GrowMethod
union case GrowMethod.ChooseTheOldest: GrowMethod
with override this.ToString() =
match this with
| RecursiveBacktracker -> "Recursive Backtracker"
| Prim -> "Prim"
| ChooseTheOldest -> "Choose the Oldest"
val createMaze : xMax:int -> yMax:int -> CellType [,] * (int * int -> Async<(int * int) []>)
Full name: Script.createMaze
val xMax : int
val yMax : int
val maze : CellType [,]
module Array2D
from Microsoft.FSharp.Collections
val create : length1:int -> length2:int -> value:'T -> 'T [,]
Full name: Microsoft.FSharp.Collections.Array2D.create
val inMaze : (int -> int -> bool)
val x : int
val y : int
val canRemoveWall : (int -> int -> bool)
val dirs : int
module Array
from Microsoft.FSharp.Collections
val sumBy : projection:('T -> 'U) -> array:'T [] -> 'U (requires member ( + ) and member get_Zero)
Full name: Microsoft.FSharp.Collections.Array.sumBy
val dx : int
val dy : int
val x' : int
val y' : int
val getPossibleDirections : (int * int -> Async<(int * int) []>)
val async : AsyncBuilder
Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val filter : predicate:('T -> bool) -> array:'T [] -> 'T []
Full name: Microsoft.FSharp.Collections.Array.filter
val map : f:('a -> 'b) -> x:'a * y:'a -> 'b * 'b
Full name: Script.map
val f : ('a -> 'b)
val x : 'a
val y : 'a
Multiple items
type MazeControl =
inherit obj
new : unit -> MazeControl
member DrawMaze : growMethod:'a -> 'b
Full name: Script.MazeControl
--------------------
new : unit -> MazeControl
val this : MazeControl
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task -> Async<unit>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken
Full name: Microsoft.FSharp.Control.Async
--------------------
type Async<'T>
Full name: Microsoft.FSharp.Control.Async<_>
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
let color, offset, size = if current then Colors.Red, 2., 6. else Colors.White, 0.5, 9.
let x, y = map (fun x -> float x * 10. + offset) cell
let rect = Rectangle(Width = size, Height = size, Fill = SolidColorBrush color)
rect.SetValue(Canvas.LeftProperty, x)
rect.SetValue(Canvas.TopProperty, y)
rect
this.Width <- float xMax * 10.
this.Height <- float yMax * 10.
let rand = System.Random()
type ResizeArray<'T> = List<'T>
Full name: Microsoft.FSharp.Collections.ResizeArray<_>
val ignore : value:'T -> unit
Full name: Microsoft.FSharp.Core.Operators.ignore
val fst : tuple:('T1 * 'T2) -> 'T1
Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2
Full name: Microsoft.FSharp.Core.Operators.snd
member MazeControl.DrawMaze : growMethod:'a -> 'b
Full name: Script.MazeControl.DrawMaze
Drawing a 21x21 maze with a specified method
static member Async.CancelDefaultToken : unit -> unit
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:System.Threading.CancellationToken -> unit
More information