4 people like it.

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.

Growing Tree Algorithm for Maze Generation

  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

Link:http://fssnip.net/7x
Posted:6 years ago
Author:Natallie Baikevich
Tags: maze , silverlight , async