In setting up a game playing program to allow easy addition of patterns (see X -> do Y),
I discovered the complete list of patterns for this puzzle:
- Find a square that, if you plant a tree there, will cause the elimination of at least one color. Mark that square as unavailable.
- Repeat step 1. until solved.
That's it :)
Here's the code for it:
#!/usr/bin/perl
# http://perlmonks.org/?node_id=1207779
use strict;
use warnings;
print local $_ = my $grid = <<END, "starting\n";
GRBBB
GRBBW
ORBBW
OOOWW
OOOOW
END
my $N = $grid =~ /\n/ && $-[0];
my $n = $N - 1;
sub clear # the no longer available squares
{
my $pick = qr/[a-z]/;
local $_ = shift;
1 while s/\w(?=.*?$pick)/-/ + s/$pick.*?\K\w/-/ # row
+ s/\w(?=(?:.{$N}.)*.{$N}$pick)/-/s # column
+ s/$pick(?:.{$N}.)*.{$N}\K\w/-/s # column
+ s/$pick.{$n}(..)?\K\w/-/s # lower diagonals
+ s/\w(?=.{$n}(..)?$pick)/-/s # upper diagonals
;
return $_;
}
sub missingcolor { $N > keys %{{ map +($_, $_), shift =~ /\w/g }} }
while( /[A-Z]/g ) # mark square to '-' if tree there causes a missing
+color
{
missingcolor( lc clear( "$`\l$&$'" ) ) and
$_ = "$`-$'",
print $_, ' ' x $N, " mark ",
$-[0] % ($N + 1), ',', int $-[0] / ($N + 1), "\n"; # x,y coords
}
print s/[A-Z]/$&/g == $N ? "\nSolved!\n" : "Failed\n";
It prints a grid for each step of the solution (slightly more than 120 lines).
|