3x3 mazes

mazes.txt

$ perl6 maz3 | perl6 sym3 | perl6 draw3 
+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+
|        |  |        |  |        |  |        |  |        |  |        |  |        |  |        |
+  +--+--+  +  +--+--+  +  +--+--+  +--+  +--+  +  +--+--+  +  +--+--+  +--+  +--+  +--+  +--+
|        |  |        |  |        |  |        |  |        |  |        |  |        |  |        |
+  +--+--+  +--+  +--+  +--+--+  +  +--+  +--+  +  +--+  +  +--+  +  +  +  +--+  +  +--+  +  +
|        |  |        |  |        |  |        |  |     |  |  |     |  |  |     |  |  |     |  |
+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+

+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+
|        |  |        |  |        |  |        |  |        |  |        |  |        |  |        |
+--+--+  +  +--+--+  +  +  +--+--+  +--+  +--+  +  +--+  +  +  +--+  +  +--+  +  +  +--+  +  +
|        |  |        |  |        |  |        |  |     |  |  |     |  |  |     |  |  |     |  |
+  +--+  +  +--+  +  +  +  +  +  +  +  +  +  +  +--+  +--+  +--+--+  +  +--+  +--+  +--+--+  +
|     |  |  |     |  |  |  |  |  |  |  |  |  |  |        |  |        |  |        |  |        |
+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+

+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+
|        |  |        |  |        |  |        |  |        |  |        |  |        |  |     |  |
+  +--+  +  +  +--+  +  +  +--+  +  +--+  +  +  +--+  +--+  +  +  +  +  +  +  +--+  +--+  +  +
|     |  |  |     |  |  |     |  |  |     |  |  |     |  |  |  |  |  |  |  |  |  |  |        |
+--+  +  +  +  +  +--+  +  +--+  +  +  +  +--+  +  +  +  +  +--+  +--+  +--+  +  +  +  +  +--+
|     |  |  |  |     |  |  |     |  |  |     |  |  |     |  |        |  |        |  |  |     |
+--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+  +--+--+--+

$ cat maz3
# bitstring; positions 0..11 correspond to vertical walls; 12..23 to horizontal
my $s = "0" x 8 ~ "1" x 4;

#   00  01
# 06  07  08
#   02  03
# 09  10  11
#   04  05

# neighboring relation; for example, wall 0 neighbors 2, 6, 7, and
# the outer wall
my @n =
    [2, 6, 7, 12], [3, 7, 8, 12],
    [0, 4, 6, 7, 9, 10], [1, 5, 7, 8, 10, 11],
    [2, 9, 10, 12], [3, 10, 11, 12],
    [0, 2, 7, 12], [0, 1, 2, 3, 6, 8], [1, 3, 7, 12],
    [2, 4, 10, 12], [2, 3, 4, 5, 9, 11], [3, 5, 10, 12],
;

repeat until $s eq "1" x 4 ~ "0" x 8 {
    # this is a quick way to find the next bitstring with the same amount of 1s
    # trick learned long ago from http://blog.plover.com/CS/parentheses.html
    $s ~~ s[ .* <( 01 (.*) ] = "10" ~ $0.comb.sort.join;
    # the final 1 represents the outer wall
    my @w = +«$s.comb, 1;

    # each iteration of this loop melts away walls at the "fringes", attached
    # to at most one thing. the loop stops when it can't melt anything more.
    repeat while my $changed {
        $changed = False;
        for ^12 -> $n {
            next unless @w[$n];
            if [+](@w[ @n[$n].list ]) < 2 {
                @w[$n] = 0;
                $changed++;
            }
        }
    }

    # the maze has all single paths if we succeeded in melting away everything
    # except the outer wall
    next unless [+](@w) == 1;
    say $s;
}

$ cat sym3 
#   00  01
# 06  07  08
#   02  03
# 09  10  11
#   04  05

my %symmetries =
    rot1 => <8 11 7 10 6 9 1 3 5 0 2 4>,
    rot2 => <5 4 3 2 1 0 11 10 9 8 7 6>,
    rot3 => <9 6 10 7 11 8 4 2 0 5 3 1>,
    flip => <4 5 2 3 0 1 9 10 11 6 7 8>,
    frt1 => <6 9 7 10 8 11 0 2 4 1 3 5>,
    frt2 => <1 0 3 2 5 4 8 7 6 11 10 9>,
    frt3 => <11 8 10 7 9 6 5 3 1 4 2 0>,
;

MAZE:
for lines() -> $line {
    my @w = $line.comb;
    next MAZE if $line gt @w[%symmetries{$_}.list].join
        for %symmetries.keys;
    say $line;
}

$ cat draw3 
constant COLUMNS = 8;

my @mazes;
sub print_mazes {
    return unless @mazes;

    for ^7 -> $n {
        sub line($maze) { $maze.lines[$n] }
        say (line($_) for @mazes).join("  ");
    }
    say "";
    @mazes = ();
}

for lines() -> $line {
    my $maze = q:to/EOF/;
        +--+--+--+
        |  :  :  |
        +..+..+..+
        |  :  :  |
        +..+..+..+
        |  :  :  |
        +--+--+--+
        EOF

    my $pos = 0;
    $maze .= subst(':', { $line.substr($pos++, 1) ?? '|' !! ' ' }, :g);
    $maze .= subst('..', { $line.substr($pos++, 1) ?? '--' !! '  ' }, :g);

    @mazes.push: $maze;
    if @mazes >= COLUMNS {
        print_mazes;
    }
}

if @mazes {
    print_mazes;
}