P is for Practical PerlMonks

### Re (tilly) 3 (rectangular): 5x5 Puzzle

by tilly (Archbishop)
 on Jan 29, 2001 at 23:13 UTC ( #55040=note: print w/replies, xml ) Need Help??

in reply to Re (tilly) 2: 5x5 Puzzle

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]);
}

Create A New User
Node Status?
node history
Node Type: note [id://55040]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (7)
As of 2018-06-19 09:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Should cpanminus be part of the standard Perl release?

Results (112 votes). Check out past polls.

Notices?