Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re (tilly) 1: 5x5 Puzzle

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


in reply to 5x5 Puzzle

At first I had ignored this, then decided to do it. It was a more fun challenge than I thought. There are, not counting the order of the moves, actually 4 solutions in 15 moves for a 5x5 board. What follows is the throw-away script I wrote to find this. By default it solves a 5x5 board. Pass it an argument and it will solve an nxn board. (I tried it in the 1..10 range and found that there is 1 solution for 1, 2, 3, 6, 7, 8 and 10. As I mentioned, there are 4 for 5, plus 16 for 4 and 256 for 9. Don't ask me why, I merely report what I found...)

It would not be hard to extend this to handle arbitrary rectangular boards. I also didn't need the globals but this is throw-away code and it was easier that way. I make no apologies for the huge numbers of anonymous functions. The fact that I can feasibly find all 64 solutions for an 11x11 board by brute-force search on my old laptop speaks loudly enough for the efficiency of the method...

use strict; use Carp; 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_toggle_square($x, $y)]; } } find_soln(); sub find_soln { if (! @toggles) { # Solved! print join " ", "Solution:", map $_->[0], @soln; print "\n"; } else { my $toggle = shift(@toggles); # Try with, then without if ($toggle->[1]->()) { push @soln, $toggle; find_soln(); pop @soln; } if ($toggle->[1]->()) { find_soln(); } unshift @toggles, $toggle; } } # Returns a function that switches one square and returns # true iff the new color is black sub ret_swap_square { my ($x, $y) = @_; #print "Generated with $x, $y\n"; my $s_ref = \($board[$x-1][$y-1]); return sub {$$s_ref = ($$s_ref + 1) %2;}; } # Returns a function that toggles one square and its # neighbours, and returns whether or not any neighbour # has turned to white and cannot return to black without # swapping again with $x lower or $x the same and $y lower. sub ret_toggle_square { my ($x, $y) = @_; my @fin_swaps; my @other_swaps; unless ($x == $min) { push @fin_swaps, ret_swap_square($x - 1, $y); } if ($x == $max) { unless ($y == $min) { push @fin_swaps, ret_swap_square($x, $y - 1); } if ($y == $max) { push @fin_swaps, ret_swap_square($x, $y); } else { push @other_swaps, ret_swap_square($x, $y); unless ($y == $max) { push @other_swaps, ret_swap_square($x, $y+1); } } } else { unless ($y == $min) { push @other_swaps, ret_swap_square($x, $y - 1); } push @other_swaps, ret_swap_square($x, $y); push @other_swaps, ret_swap_square($x + 1, $y); unless ($y == $max) { push @other_swaps, ret_swap_square($x, $y + 1); } } return sub { $_->() foreach @other_swaps; my $ret = 1; $ret *= $_->() foreach @fin_swaps; return $ret; } }


Comment on Re (tilly) 1: 5x5 Puzzle
Download Code
Re: Re (tilly) 1: 5x5 Puzzle
by extremely (Priest) on Jan 29, 2001 at 11:57 UTC
    Thinking about the nature of the beast, I'd bet on powers of 4 having extra solutions and the squares that that have 4xN+1 sides (5, 9, 13, 17) having extra solutions as well. I think the 16x16 will have at least 2**16 solutions since it is actually a 2x2 of 4x4s and the 4x4 had 2**4 solutions. It also wouldn't suprise me that 13x13 had 8**8 solutions.

    --
    $you = new YOU;
    honk() if $you->love(perl)

      Actually there is but one solution of size 13 but 16 again of size 14.

      Note that choosing the values for one side suffice to lay out the rest of the board. I think that has something to do with the pattern.

      OK, I figured I would tackle this problem smarter, not harder. With some success.

      First of all note that if you specify the first column, the next column is completely determined by the need to make the entries in the first column come out black. The following column is likewise determined by the need to make the entries in the second column come out black. And so on to the end. So it all comes down to choosing the first column correctly so that the n'th column comes out all black. (Or equivalently so that nothing would go into the n+1'th column.)

      But note, what happens if you compare what happens if you reverse a single choice in the first column. Well you get a pattern of switching what toggles you make through the rest of the puzzle! And the pattern of switches does not depend upon what other parameters you chose. (The final outcome of toggle/not toggle depends on other patterns, but the pattern of toggles you reverse for a single toggle does not.)

      To someone with a math background this looks suspiciously like a linear algebra problem over Z/2. (Z/2 is the set of integers mod 2 - ie 1's and 0's with addition and multiplication mod 2.) In fact it is. For each choice in the first column we have a pattern of switches it would make to toggles in the n+1'st column. If we start with a blank first column we have a pattern of switches we see in the n+1'st column. We want to find a linear combination (that is linear combination in Z/2) of choices in the first column that add up to that base pattern of switches and cancels it out.

      Basic linear algebra tells us that the answer set is either empty or a vector space of some dimension over Z/2. So this doesn't tell us why there are any solutions, but it does tell us that if we have a solution, the number of solutions will be a power of 2. Of course we have seen cases where we have 1 solution, 2**2 solutions, 2**2**2 solutions, 2**2**2**2 solutions, and I suspect that 19 has 2**2**2**2**2 solutions. Why that is seen I don't know. I don't even know why there are any solutions.

      However if I remain interested enough over the next couple of days, I know I can use linear algebra to find how many solutions to the n*n problem exist. That can be O(n**3) rather than the current exponential beast. If I do that I will probably want to do the general n*m problem. And I am not sure how easy my reasoning will be for others to figure out. So I may not do it.

      But if anyone is interested, tell me about it and I will be more likely to take the effort. :-)

Re (tilly) 2: 5x5 Puzzle
by tilly (Archbishop) on Jan 29, 2001 at 14:09 UTC
    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...)

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://54957]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (8)
As of 2014-08-02 08:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (55 votes), past polls