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