masak's maze puzzle

reboot.p6

role Grid::Mazable {
    #| Get list of nodes
    method nodes { ... }

    #|[
        A leaf node represents a fringe of the grid that we're allowed to
        recurse off of when we build mazes. Not all fringes are leaves, due to
        the fact that mazes can include numerous dead-ends. When a fringe is
        not a leaf, it's a dead-end.
    ]
    has @.leaves;
    method add-leaf($l) { @!leaves.push($l) }

    #| Connect two nodes by a path; alternatively, "melt" the walls between them
    method connect($node1, $node2) returns Grid::Mazable { ... }
    #| True if a node is not connected to any other nodes
    method disconnected($node) returns Bool { ... }
    #| Returns all of the potential neighbors of a node
    method neighbors($node) { ... }

    #|[
        Returns the number of mazes a given grid has.

        Assumes a disconnected grid; any nodes with connections within the grid
        will be considered walls, in which case an alternative starting point
        for maze-generating can be choosen by setting @!leaves to it, or by
        using Grid.add-leaf($starting-point)
    ]
    method number-of-mazes returns Int {
        self!number-of-mazes-rec: $.nodes.grep({$.disconnected($^node)}) - 1;
    }

    #|[
        If the grid is already a maze, returns 1.  Otherwise, generate grids
        from all of the possible combinations of new connections we could make
        from our current set of leaves, and sum the results of calling
        grid!number-of-mazes-rec($disconnected-spots-$new-connections) on all
        of those grids.

        We know that all of the grids we generated contain new sub-mazes
        because when we determine the possible new connections we could make,
        we ignore any neighbors of leaves that already have connections, thus
        ensuring that there are no circular connections. Take the node
        fragement here, where "o"s are normal nodes, "x"s leaf nodes, and lines
        between nodes connections:

            o-x                              +--+--+
            |    (represents something like: |   **| )
            o-o                              +  +--+
                                             |     |
                                             +--+--+

        If the leaf made a connection downward, the grid would no longer be a maze:

            o-o
            | |
            o-o

        To generate the possible combinations of connections, we note that for
        a set of leaves, only one leaf out of the set can create a connection
        to a given neighboring node, since if more than one leaf were allowed to
        connect, it would violate the maziness of the grid, just like above.

            o-x
            |
            x o

        Above, both leaves can't connect to the last node in the same grid, or
        the grid wouldn't be a maze. We solve this by focusing on the nodes
        that we can potentially connect to. %possible-connections collects a
        list of nodes and the leaves that could connect to it. Then, for each
        node that we can connect to, we create a new grid for each connection
        that we could make to that node, and recurse on it. In the case above,
        we'd make a grid for:

            o-o
            | |
            o x

        and for:

            o-o
            |
            o-x

        Note also that the new grids have leaves only at the new connections;
        this is to ensure we both generate all possible dead-ends of the maze,
        by letting the old leaves die, and can still recurse and expand the
        maze when possible, by creating the new leaves.

        In as case like this:

            o-o-o
            | | |
            x x o
                |
            o o o

        We know that either:

        =item1 the 1st leaf connects down and the 2nd leaf is a dead-end
        =item2 the 2nd leaf connects down and the 1st leaf is a dead-end
        =item3 both leaves connect down

            1. o-o-o    2. o-o-o    3. o-o-o
               | | |       | | |       | | |
               o o o       o o o       o o o
               |   |         | |       | | |
               x o o       o x o       x x o

        In terms of the nodes that we can connect to, this means:

        =item1 the 1st node is connected to and becomes a leaf, and the 2nd leaf dies fruitlessly
        =item2 the 1st leaf dies fruitlessly, and the 2nd node is connected to and becomes a leaf
        =item3 both nodes are connected to and become the new leaves

        To do this, we create a grid with the 1st connection, and only the 1st
        node as the leaf, and recurse on it, covering case 1. Then, the 2nd
        connection is made for both the original grid and the grid we just
        created, adding the 2nd node as a leaf to both. This covers both cases
        2 and 3.

        In conjunction with the earlier rule about disconnected nodes with more
        than one neighboring leaf, we can continue in this fashion for any
        number of leafs at once by accumulating a list a previously created
        grids and applying the new connections to all of them.

        By covering all possibilites for each sub-maze, we know inductively
        that we've covered all the possibilities for all mazes the grid can
        have that pass through the starting point.
    ]
    method !number-of-mazes-rec(Int $disconnected-spots) returns Int {
        if $disconnected-spots {
            # If there are disconnected spots, this isn't a maze.
            # Collect all the leaves that point to each disconnected node
            my %possible-connections{Any}; # node => leaves
            for @.leaves || $.nodes[0] -> $leaf {
                for $.neighbors($leaf).grep({ $.disconnected($_) }) {
                    %possible-connections{$_}.push: $leaf;
                }
            }
            my @grids = self.clone(:leaves[]);
            # Sum the number of sub-mazes:
            [+] %possible-connections.kv.map: -> $node, @leaves {
                # Iterate over already-generated nodes so that all ur bases are belong to us:
                eager @grids.map: -> $grid {
                    # Separating the first new grid from the rest is an optimization,
                    # so that we don't have to do so much cloning:
                    @grids.push: my $g-new-first = $grid.clone;
                    # All new grids are going to connect to $node somehow:
                    $g-new-first.add-leaf($node);
                    # Cover different leafs trying to connect to $node:
                    (eager @leaves[1..*].map: -> $leaf {
                        @grids.push: my $g-new = $g-new-first.clone;
                        # Recurse to get the number of sub-mazes:
                        $g-new.connect($node, $leaf)\
                            !number-of-mazes-rec($disconnected-spots - $g-new.leaves)
                    }), $g-new-first.connect($node, @leaves[0])\
                            !number-of-mazes-rec($disconnected-spots - $g-new-first.leaves)
                }
            }
        } else {
            # No more nodes to connect, so this must be a maze.
            # Do any post-processing:
            if $*debug {
                say "Supposed maze ending at nodes $.leaves():";
                say self;
                say '';
                say '=' x 10;
                say '';
            }
            if $*numify { say self.numify }
            1
        }
    }
}

class Grid::TwoDimensional does Grid::Mazable {
    has $.width;
    has $.height = $!width;
    method rows { $.nodes.rotor($!width, 0) }
    has @.nodes = ^( $!width * $!height );
    has @.paths = self.nodes.map({set()});
    method connected-to ($n1, $n2) { @.paths[$n1]{$n2} }
    method connect(int $node1, int $node2) {
        @!paths[$node1] (|)= $node2;
        @!paths[$node2] (|)= $node1;
        self
    }
    has %!disconnected_cache{Any};
    method disconnected($node) returns Bool {
        %!disconnected_cache{$node} //= $node.defined and not @!paths[$node]
    }
    method neighbors($node) {
        ($!width <= $node                 ?? $node - $!width !! Any),
        (0 < $node % $!width              ?? $node - 1       !! Any),
        ($node % $!width < $!width - 1    ?? $node + 1       !! Any),
        ($node < ($!height - 1) * $!width ?? $node + $!width !! Any),
    }

    method clone(:$leaves = @!leaves.clone, :$paths = @!paths.clone, *%_) {
        $?CLASS.new:
            :$!width,
            :$!height,
            :@!nodes, # assume @!nodes is unchanging
            :$paths,
            :$leaves,
            |%_
    }
    method gist {
        $.rows.map(-> @row {
            my @rowline;
            my @colline;
            for @row -> $node {
                my @n := self.neighbors($node);
                @rowline.push: 'o', ($.connected-to($node, @n[2]) ?? '-' !! ' ');
                @colline.push: $.connected-to($node, @n[3]) ?? '|' !! ' ';
            }
            @rowline[0..*-2].join, @colline.join(' ')
        })\
            .flat[0..*-2]\ # skip last, blank, @colline
            .join("\n")
    }
    method numify {
        my $rows;
        my $cols;
        for @.rows.kv -> $horz, @row {
            for @row.kv -> $vert, $node {
                my @n := self.neighbors($node);
                $rows ~= +!$.connected-to($node, @n[2]) if $vert + 1 < $!width;
                $cols ~= +!$.connected-to($node, @n[3]) if $horz + 1 < $!height;
            }
        }
        $rows~$cols;
    }
}

sub MAIN($width = 3, $height = $width, :$*debug, :$*numify) {
    say Grid::TwoDimensional.new(:$width, :$height).number-of-mazes;
}

reboot.quicker.p6

my int $width = 3;
my int $height = 3;
say num-mazes;
class Grid {
    has @.leaves = 0;
    method add-leaf($l) { @!leaves.push($l) }
    has @.nodes;
    method connect-and-run(int $node1, int $node2, int $d-spots is copy --> Int) {
        @!nodes[$node1] = 1;
        @!nodes[$node2] = 1;
        if 0 == (my $d-spots-new = $d-spots - @!leaves) {
            1
        } else {
            self.number-of-mazes-rec($d-spots-new)
        }
    }

    method clone(--> Grid) {
        Grid.new: :nodes(@!nodes.clone), :leaves(@!leaves.clone);
    }

    method number-of-mazes-rec(int $disconnected-spots) returns Int {
        my %possible-connections{Any};
        for @!leaves -> $leaf {
            for neighbors($leaf).grep({ not @!nodes[$_] }) -> $node {
                %possible-connections{$node}.push: $leaf;
            }
        }
        my @grids = Grid.new(:@!nodes, :leaves[]);
        [+] %possible-connections.kv.map: -> $node, @leaves {
            eager @grids.map: -> Grid $grid {
                @grids.push: my Grid $g-new-first = $grid.clone;
                $g-new-first.add-leaf($node);
                (eager @leaves[1..*].map: -> $leaf {
                    @grids.push: my $g-new = $g-new-first.clone;
                    $g-new.connect-and-run($node, $leaf, $disconnected-spots)
                }), $g-new-first.connect-and-run($node, @leaves[0], $disconnected-spots)
            }
        }
    }
}

sub num-mazes {
    Grid.new.number-of-mazes-rec($width*$height - 1);
}

sub neighbors(int $node) is pure {
    ($node - $width if $width <= $node), # Top
    ($node - 1 if 0 < $node % $width), # Left
    ($node + 1 if $node % $width < $width - 1), # Right
    ($node + $width if $node < ($height - 1) * $width), # Bottom
}