Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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

In reply to Re (tilly) 3 (rectangular): 5x5 Puzzle by tilly
in thread 5x5 Puzzle by Adam

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and a log crumbles through the grate...

    How do I use this? | Other CB clients
    Other Users?
    Others having an uproarious good time at the Monastery: (3)
    As of 2018-01-20 07:21 GMT
    Find Nodes?
      Voting Booth?
      How did you see in the new year?

      Results (226 votes). Check out past polls.