Re: Parks Puzzle

This is my basic puzzle solver method.
Keep a queue of partial solutions. Throw out ones that violate the rules.
Then add new partial solutions (one for each square of the next color) on the queue.
You're solved if no colors are left, because you've put a tree in each color, and you fail if the queue is empty.

Simple, eh?

#!/usr/bin/perl

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

use strict;
use warnings;

my $start = <<END;
GRBBB
GRBBW
ORBBW
OOOWW
OOOOW
END

my $gap = $start =~ /\n/ && $-[0] - 1;
my $egap = $gap + 2;

my @queue = $start;
while( @queue )
  {
  local $_ = shift @queue;
  /#.*#/ and next;                      # same row
  /#(?:.{$gap}..)*.{$gap}.#/s and next; # same column
  /#(.{$gap,$egap}|)#/s and next;       # adjacent trees
  if( /[A-Z]/ ) # pick a color
    {
    push @queue, "$`#$'" =~ s/$&/\l$&/gr while /$&/g;
    }
  else
    {
    print "$start\nwin with\n\n$_";
    exit;
    }
  }
die "failed to find solution\n";
[download]

Comment on Re: Parks Puzzle Download Code

Replies are listed 'Best First'.
Re^2: Parks Puzzle by trippledubs (Deacon) on Jan 22, 2018 at 16:08 UTC
Simple, eh? It gets simpler after you look up @-, $`, $&, $', \l modifier, add a couple of data dumps, think through the regex greediness and backtracking, dig into precedence.. `/#.#/ and next; # same row` [download] That is pretty easy to see how it works, without the /s modifier, . does not match newline, so two #s in the same line. Your comment spells it out, but it makes your intent clear for the next couple lines which are a little bit harder to see how they work. `/#(?:.{$gap}..).{$gap}.#/s and next; # same column` [download] The greediness of the first portion `(?:.{$gap}..)*` marches the regex all the way to the end of the grid while `.{$gap}.#` backtracks so it tries to make a match. Then of course the best line and, also would like to mention that, I super searched for '`while /$&/g`' just to see if it was somewhere else, and only this node came up making it pretty unique. push @queue, "$`#$'" =~ s/$&/\l$&/gr while /$&/g; [download] That line makes me love and hate perl at the same time. Creating and pushing the partial solutions to @queue in one line. It iterates through the grid, for the letter it has matched earlier `[A-Z]`, adds this grid with the instance of the letter changed to #, and all other instances of the letter lowercased with \l. The alternation operator in `/#(.{$gap,$egap}\|)#/s` is not used or maybe I don't understand, I think perl should not compile that, but `print 'yes' if 'a' =~ /(b\|)/;` [download] works and matches, so back to the books, seems that empty alternations always match, so that means this alternative is checking for two '#'s in a row, which would already be matched by that point. In other search result coincidences, exactly one year ago today, someone tried to get perl critic to disallow empty alternations. Very neat solution to a fun problem, easy enough to dig into and understand a little bit more perl. Thanks for sharing.	[reply] [d/l] [select]
Re^3: Parks Puzzle by tybalt89 (Monsignor) on Jan 23, 2018 at 01:09 UTC
Good catch on the empty alternative! As far as I can tell it's there from the beginning when I tried to write the three tests in one regex. I missed it when I split them up to make them clearer. It doesn't hurt anything, however. The line push @queue, "$`#$'" =~ s/$&/\l$&/gr while /$&/g; made me giggle a little when I wrote it :) I often giggle when writing perl, it's one heck of a great language.	[reply] [d/l]