in reply to Re^2: Parks Puzzle
in thread Parks Puzzle

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:

  1. Find a square that, if you plant a tree there, will cause the elimination of at least one color. Mark that square as unavailable.
  2. 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).