Simple maze generation in Perl

Posted:

Sometimes, you just want to generate mazes. The code presented here is a depth-first search.

A couple of notes about the code below. It works with vanilla, 2D grids, but these can be of varying sizes. The maze data is stored is a simple 2D array. Each room is presented as a hash. The algorithm needs to track which rooms have been visited (more on this later). Any room may also not have a south (bottom) wall or an east (right) wall.

The following code initializes the maze structure:

sub init_maze {
  my ($max_row, $max_col) = @_;

  my $maze = [];
  for (my $r=0; $r < $max_row; $r++) {
     for (my $c=0; $c < $max_col; $c++) {
        push @{$maze->[$r]}, {'visited' => 0,
                 'bottom'  => 1,
                             'right'   => 1,
                            };
     }
  }
  return $maze;
}

No surprises there.

The real work happens in the next bit of code, make_maze(). Given a starting point specified by a row and column coordinate in the 2D maze array, it marks the room as “visited”. It then looks for neighboring rooms that have not yet been visited. It randomly selects one of these and knocks down the wall between them. It then recursively calls make_maze() with the new room.

Get it? No? That’s OK. Recursive code takes a long time to trust.

sub make_maze {
  my ($maze, $row, $col) = @_;

  $maze->[$row]->[$col]->{'visited'} = 1;

  while (my $unvisited = get_unvisited($maze, $row, $col)) {
    last unless @$unvisited;

    # Randomly select a neighbor
    my $choice = $unvisited->[ rand(@$unvisited) ];

    # Knock down the wall between them
    remove_wall($maze, [$row, $col], $choice);

    # move to this new cell
    make_maze($maze, $choice->[0], $choice->[1]);
  }
}

There are two details worth investigating. The first is how unvisited neighbors are selected. The second is how to figure out which wall to remove. Here’s the unvisited neighbor code:

sub get_unvisited {
  my ($maze, $row, $col) = @_;
  my @found;

  # look for neighbors in cardinal directions;
  # be mindful of maze bounderies
  if ($row == 0) {
    push @found, [$row + 1, $col] unless $maze->[$row + 1]->[$col]{'visited'};
  } elsif ($row == @$maze - 1) {
    push @found, [$row - 1, $col] unless $maze->[$row - 1]->[$col]->{'visited'};
  } else {
    if ($row + 1 < @$maze) {
      push @found, [$row + 1, $col] unless $maze->[$row + 1]->[$col]->{'visited'};
    }
    push @found, [$row - 1, $col] unless $maze->[$row - 1]->[$col]->{'visited'};
  }

  if ($col == 0) {
    push @found, [$row, $col + 1] unless $maze->[$row]->[$col + 1]->{'visited'};
  } elsif ($col == (@{$maze->[0]} - 1)) {
    push @found, [$row, $col - 1] unless $maze->[$row]->[$col - 1]->{'visited'};
  } else {
    if ($col + 1 < @{$maze->[0]}) {
      push @found, [$row, $col + 1] unless $maze->[$row]->[$col + 1]->{'visited'};
    }
    push @found, [$row, $col - 1] unless $maze->[$row]->[$col - 1]->{'visited'};
  }

  return \@found;
}

This code is pretty straight-forward. It observes the boundary rooms and makes sure that these rooms have not yet been visited. There are clever ways of reducing this code, but this is easier to understand, I think.

Removing the right wall is simply a matter of looking at two rooms and figuring out if the rooms are joined horizontally or vertically. It is then pretty easy to remove the right or bottom of wall of the correct room.

sub remove_wall {
  my ($maze, $r1, $r2) = @_;
  my $selected;

  if ( $r1->[0] == $r2->[0] ) {
    # Rows are equal, must be East/West neighbors
    $selected = ($r1->[1] < $r2->[1]) ? $r1 : $r2;
    $maze->[ $selected->[0] ]->[ $selected->[1] ]->{'right'} = 0;

   } elsif ( $r1->[1] == $r2->[1] ) {
     # Columns are the same, must be North/South neighbors
     $selected = ($r1->[0] < $r2->[0]) ? $r1 : $r2;
     $maze->[ $selected->[0] ]->[ $selected->[1] ]->{'bottom'} = 0;
   } else {
     die("ERROR: bad neighbors ($r1->[0], $r1->[1]) and ($r2->[0], $r2->[1])\n");
   }
   return;
}

It would be useful to print out a bird’s eye view of the maze and that’s done (admittedly awkwardly) in the following routine.

sub print_maze {
   my ($maze) = @_;
   my $screen = [];

   my $screen_row = 0;
   for (my $r=0; $r < @$maze; $r++) {
     if ($r == 0) {
       # Top border
       push @{$screen->[$r]}, '+';
       for (@{$maze->[0]}) {
     push @{$screen->[$r]}, '--', '+';
       }
     }

     for (my $c=0; $c < @{$maze->[0]}; $c++) {
       my @middle;
       if ($c == 0) {
     push @middle, "|";
       }

       push @middle, "  "; # room center
       if ($maze->[$r]->[$c]->{'right'}) {
     push @middle, "|";
       } else {
     push @middle, " ";
       }
       push @{$screen->[$screen_row + 1]}, @middle;

       my @bottom;
       if ($c == 0) {
     push @bottom, "+";
       }

       if ($maze->[$r]->[$c]->{'bottom'}) {
     push @bottom, "--";
       } else {
     push @bottom, "  ";
       }
       push @bottom, "+";
       push @{$screen->[$screen_row + 2]}, @bottom;
     }
     $screen_row += 2;
   }

   for (my $r=0; $r < @$screen; $r++) {
     for (my $c=0; $c < @{$screen->[0]}; $c++) {
       print $screen->[$r]->[$c];
     }
     print "\n";
   }
   print "\n";
}

Finally, here’s the main line:

my $dimension = $ARGV[0] || 5;
my $maze = init_maze($dimension, $dimension);

my ($startRow, $startCol) = (int(rand($dimension)), int(rand($dimension)));
make_maze($maze, $startRow, $startCol, undef);

print_maze($maze);

Hope this helps get you started in the wonderful world of maze building!