TL;DR

Playing with Curses in Perl is funny. Making a simple game is instructive. Generate it dynamically is rewarding.

In the previous post A Maze with Curses we introduced a simple Curses-based game in Perl that allows a player to solve a maze. Alas, that game quickly becomes boring because it always presents the same maze… algorithms to the rescue!

Generating mazes programmatically

The Wikipedia page on maze generation has this interesting consideration:

Wilson’s algorithm […] generates an unbiased sample from the uniform distribution over all mazes, using loop-erased random walks.

We already encountered loop-erased random walks in our previous post on path-loop-erasure, so it seems that we only need to generate random walks! Well, only slightly more than this…

Maze generation entry point

The following function drives the generation of a new maze:

sub generate_maze ($rows, $cols) {
   $_ -= 2 for $rows, $cols; # will add boundary walls at the end
   my @maze = map { [('#') x $cols] } 1 .. $rows;
   $maze[0][0] = ' '; # starting position is in maze
   my $row = 0;
   my $col = 0;
   while ($row < $rows) {
      if ($maze[$row][$col] eq '#') { # not reached yet
         my $path = random_walk(\@maze, $row, $col);
         say $_->{id} for $path->@*; 
         $path = path_loop_erasure($path);

         # apply path to maze
         my ($pr, $pc);
         my $n = 0;
         for my $v ($path->@*) {
            my ($r, $c) = $v->@{qw< row col >};
            printf {*STDERR} "row<$r> col<$c>\n";
            $maze[$r][$c] = ' ';
            $maze[($r + $pr) / 2][($c + $pc)/2] = ' ' if defined $pr;
            ($pr, $pc) = ($r, $c);
         }
      }
      $col += 2;
      ($row, $col) = ($row + 2, 0) if $col > $cols;
   }
   my $hwall = '#' x ($cols + 2);
   join "\n", $hwall, (map { join '', '#', $_->@*, '#' } @maze), $hwall;
}

It gets in input the number of rows and colums where the maze has to fit, and outputs a string with the maze (walls represented by # characters).

The maze itself is generated over a smaller area, i.e. two less columns and two less rows, so that we save space for surrounding the whole maze with walls. This is why $rows and $cols are decremented by 2 at the beginning, and there are some #-based string manipulations at the end.

The starting position is marked as “belonging to the maze”. Then the generaton proceeds like this:

• a new “starting point” is chosen that is not alredy part of the maze
• a random walk is generated to connect this new “starting point” to the already-defined maze
• the random walk is simplified to remove loops
• the resulting loop-free path is “carved” on the maze

Random walk

The random walk function is the following:

sub random_walk ($maze, $r, $c) {
   my @retval;
   my @moves = ([-2, 0], [0, 2], [2, 0], [0, -2]);
   my $Mr = $#$maze;
   my $Mc = $#{$maze->[0]};
   while ('necessary') {
      push @retval, {
         row => $r,
         col => $c,
         id  => "$r-$c",
      };
      last if $maze->[$r][$c] eq ' ';
      my $move = @moves[rand @moves];
      my ($cr, $cc) = ($r + $move->[0], $c + $move->[1]);
      next if $cr < 0 || $cr > $Mr || $cc < 0 || $cc > $Mc;
      ($r, $c) = ($cr, $cc);
   }
   return \@retval;
}

The maze generation always considers that walls occur on odd-numbered rows or columns, and even-numbered rows and columns host the vertices for the random walk. This is why the @moves always considers stepping by 2 units instead of 1.

A simple check verifies that the random step is still within the boundaries. The code is structured so that the final position (which is always already part of the maze generated so far) is included in the path. This is why the while loop has an always-true condition and the real exit from the loop is perfomed by last.

Path loop erasure

Erasing the loops from the random walk has already been discussed in a previous post. The code here is only slightly different because the path does not contain identifiers, but anonymous hashes with a key id to be used for comparison:

sub path_loop_erasure ($input_path) {
   my @output_path;
   my $i = -1;
   my $N = $input_path->@*;
   while (++$i < $N) {
      print "i<$i>\n";

      # find latest occurrence of $input_path->[$i]
      my $j = $i;
      while (++$j < $N) {
         # "advance" $i if the corresponding item is found
         # later in the array
         $i = $j if $input_path->[$i]{id} eq $input_path->[$j]{id};
      }

      # whatever, this item fits into the output
      print "  --> i<$i>\n";
      push @output_path, $input_path->[$i];
   }
   return \@output_path;
}

Maze loading

Loading the maze has been modified to account for the dynamic generation:

my $maze = load_maze(@ARGV[0,1]);

# ...

sub load_maze ($rows, $cols) {
   $rows //= 15;
   $cols //= 49;
   $rows-- unless $rows % 2;
   $cols-- unless $cols % 2;
   my $maze = generate_maze($rows, $cols);

   return {
      exit => [$rows - 1, $cols - 2], # lower-right corner
      hero => [1, 1],   # upper-left  corner
      maze => $maze,
      moves => 0,
   };
}

The program optionally accepts dimensions in input, otherwise defaults to 15 rows by 49 columns.

Overall program

The overall program is an evolution of the one described in the previous article and can be found here: a-maze-ing-2.

Happy solving of random mazes!