note
tilly
Must...stop...tinkering...<P>
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.
<code>
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]);
}
</code>
54682
54968