Must...stop...tinkering...
Anyways the above was so darned close to working for
rectangular boards that I just had to extend it to cover
that. It defaults to 5x5. If you pass one argument it
does nxn. 2 and it does nxm. Still just brute force.
use strict;
use vars qw($min $max_x $max_y @board @soln @toggles);
$min = 1;
$max_x = shift(@ARGV) || 5;
$max_y = shift(@ARGV) || $max_x;
# The board starts empty and entries will autovivify. :-)
foreach my $x ($min..$max_x) {
foreach my $y ($min..$max_y) {
push @toggles, [
[$x, $y],
ret_valid_toggles($x, $y),
ret_toggle_square($x, $y)
];
}
}
# Sort them in an order where conclusions are discovered faster
@toggles = sort {
($a->[0][0] + $a->[0][1]) <=> ($b->[0][0] + $b->[0][1]) or
$a->[0][0] <=> $b->[0][0]
} @toggles;
find_soln();
sub find_soln {
if (! @toggles) {
# Solved!
print join " ", "Solution:", map "$_->[0][0]-$_->[0][1]", @soln;
print "\n";
}
else {
my $toggle = shift(@toggles);
foreach ($toggle->[1]->()) {
if ($_) {
$toggle->[2]->();
push @soln, $toggle;
find_soln();
pop @soln;
$toggle->[2]->();
}
else {
find_soln();
}
}
unshift @toggles, $toggle;
}
}
# Returns a function that toggles one square and its
# neighbours.
sub ret_toggle_square {
my ($x, $y) = @_;
my @to_swap= square_ref($x, $y);
unless ($x == $min) {
push @to_swap, square_ref($x - 1, $y);
}
unless ($y == $min) {
push @to_swap, square_ref($x, $y - 1);
}
unless ($x == $max_x) {
push @to_swap, square_ref($x + 1, $y);
}
unless ($y == $max_y) {
push @to_swap, square_ref($x, $y + 1);
}
return sub { $$_ = not $$_ foreach @to_swap; };
}
# Returns a test functions that returns a list of valid
# toggle states to try
sub ret_valid_toggles {
my ($x, $y) = @_;
my @checks;
if ($min < $x) {
push @checks, square_ref($x-1, $y);
}
if ($max_x == $x) {
if ($min < $y) {
push @checks, square_ref($x, $y-1);
}
if ($max_y == $y) {
push @checks, square_ref($x, $y);
}
}
if (not @checks) {
return sub {(0, 1)};
}
else {
my $check = shift @checks;
if (not @checks) {
return sub {not $$check};
}
else {
return sub {
my $val = $$check;
(grep {$$_ != $val} @checks) ? () : not $val;
};
}
}
}
# Given x, y returns a reference to that square on the board
sub square_ref {
my ($x, $y) = @_;
return \($board[$x-1][$y-1]);
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.