#!/usr/bin/perl -l

# http://perlmonks.org/?node_id=1207373

use strict; # regex Parks Puzzle
use warnings;
use re 'eval';

print "Initial grid:\n\n", my $board = <<END;
GRBBB
GRBBW
ORBBW
OOOWW
OOOOW
END

my $N = $board =~ /\n/ && $-[0];
my @letters = sort keys %{{ map {;$_, $_} $board =~ /\w/g }};
my @squares;
push @squares, "$&" . $` =~ tr/\n// . ',' . length($`) % ($N + 1)
  while $board =~ /\w/g;
$_ = join ' ', sort @squares;        # string to be matched
print "String to be matched (color,row,col):\n\n$_";

my $count = 0;
my $regex = '';
for my $color ( @letters )
  {
  my $y = 2 * $count + 1;
  my $x = $y + 1;
  $count and $regex .= ".*\n";
  $regex .= "$color(\\d+),(\\d+)\\b\n";
  my @tests;
  for my $prev ( 0 .. $count - 1 )
    {
    my $yy = 2 * $prev + 1;
    my $xx = $yy + 1;
    push @tests, "\$$yy == \$$y", "\$$xx == \$$x",    # same row & same col
      "abs \$$yy - \$$y < 2 && abs \$$xx - \$$x < 2"  # diagonal neighbor
      ;
    }
  @tests and $regex .= "(??{" . join(' || ', @tests) . " ? 'fail' : ''})\n";
  $count++;
  }
print "\nRegex (match one of each color with conditions):\n\n$regex";

my $matches = join ' ', /$regex/x;             # let regex do the hard work
print "Captures from regex (row,col pairs of solution):\n\n$matches\n";

my $grid = $board =~ s/\w/-/gr;                  # build grid & insert answer
substr $grid, $1 * ($N + 1) + $2, 1, shift @letters
  while $matches =~ /(\d+) (\d+)/g;
print "Formatted solution:\n\n$grid";