Shaking maze generator

Note

This blogpost requires familiarity with previous one.

Low branching factor

One of the disadvantages of using DFS to build mazes is “low branching factor”. The problem is that it actually runs for long time before hitting dead-end and having to backtrack, so it creates very long corridors with no room to “make the wrong turn” for potential maze explorer.
Let’s deal with it.

The algorithm

Originally I used recursive version, but to avoid stack overflow, actual demo was done non-recursive version of DFS.

1
2
3
4
5
6
7
8
9
10
11
12
13
let stackless mark test fanout node = seq {
let mutable stack = [[node]]
while stack.Length > 0 do
let head, stack' =
match stack with
| [] -> None, []
| [] :: rest -> None, rest
| (head :: tail) :: rest ->
if test head then None, tail :: rest
else head |> apply mark |> Some, (head |> fanout |> List.ofSeq) :: tail :: rest
match head with | Some n -> yield n | _ -> ()
stack <- stack'
}

This version will be modified to allow “shaking the stack”. I’ll introduce one argument (shake) and use shake stack instead of just stack in match statement.

1
2
3
4
5
6
7
8
9
10
11
12
13
let stackless mark test fanout shake node = seq { // <-- here
let mutable stack = [[node]]
while stack.Length > 0 do
let head, stack' =
match shake stack with // <-- and here
| [] -> None, []
| [] :: rest -> None, rest
| (head :: tail) :: rest ->
if test head then None, tail :: rest
else head |> apply mark |> Some, (head |> fanout |> List.ofSeq) :: tail :: rest
match head with | Some n -> yield n | _ -> ()
stack <- stack'
}

That’s absolutely it in “The algorithm” layer.

The glue

There was a “glue” layer adapting “The algorithm” to “The domain” and it just stopped working as we added new argument to the function. Don’t worry, though, it just a simple fix.

Previously it was calling traverse (or stackless depending which approach you used ‘elegant’ or ‘safe’) now it should call stackless (as traverse does not support shaking) with this extra argument. So the old code:

1
2
InitAt (0, 0) 
|> DFS.stackless (targetOf >> mark) (targetOf >> test) (targetOf >> fanout >> Array.shuffle)

should be changed to:

1
2
InitAt (0, 0) 
|> DFS.stackless (targetOf >> mark) (targetOf >> test) (targetOf >> fanout >> Array.shuffle) id

and the code will compile again and work exactly as it was working before (you may remember that id function does absolutely nothing). Why we did that then?

Because now, on every single step we have an ability to modify the backtracking stack.

I’ll suggest something like:

1
2
3
let shake stack = 
if Random.random () > 0.01 then stack
else stack |> Array.ofList |> apply Array.shuffleInPlace |> Array.toList

Which in 99% of cases returns stack unmodified but from time to time shuffles it completely. Of course, it would be nice to use it now (id gets replaced by shake):

1
2
InitAt (0, 0) 
|> DFS.stackless (targetOf >> mark) (targetOf >> test) (targetOf >> fanout >> Array.shuffle) shake

Please note, that from algorithm complexity point of view this is not good approach, as complexity just jumped from O(N) to O(N^2) (it’s a little but more complicated than that), but definitely it gives better results, as it tries to branch earlier.

Pushing forward on the left, branching early on the right

The bottom line is that I did not really modify the algorithm (DFS) I just injected some extra behavior into it, but it is totally externally controlled (kind of definition of “injected”, right?). Functional composition rlz.