After some thought I realized that I could find several
speedups. The first and biggest is what order the toggles
are searched in. When you choose elements on one side, you
can conclude diagonally. But I have to fill in the entire
board before drawing interesting conclusions. Therefore by
just reording what path you take you move the decision
closer to the conclusion and speed things up.
The other thing that I changed is that I separated the
decision about what paths to take from the toggling. As it
stands for most of the board the decision is obvious
from examining one board element what you have to do. But
I was toggling twice whether or not I needed it. But by
separating out that logic I make the logical structure
simpler, and I believe it is slightly faster.
So here is a much speeded up version of the code:
use strict;
use vars qw($min $max @board @soln @toggles);
$min = 1;
$max = shift(@ARGV) || 5;
@board = map [map 0, $min..$max], $min..$max;
foreach my $x ($min..$max) {
foreach my $y ($min..$max) {
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) {
push @to_swap, square_ref($x + 1, $y);
}
unless ($y == $max) {
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) {
if ($min < $y) {
push @checks, square_ref($x, $y-1);
}
if ($max == $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]);
}
UPDATE
Removed the ret_swap_square() function. Toggles go much faster if each swap is done directly rather than
indirectly through a function call. (Removing 5 extra
function calls per toggle matters...) Also dropped the
unused Carp that snuck in through habit. (This is
throw-away code...)
-
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.