We don't bite newbies here... much 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
in thread 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?
 Discipulus i'm doing an hard work to convince hime to not leave perl nor pm... many direct mails too [marto]: who? [Eily]: "hime"? The perl princess? [Discipulus]: oops ! [marto]: who are we talking about?

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (9)
As of 2017-06-23 09:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How many monitors do you use while coding?

Results (539 votes). Check out past polls.