This is PerlMonks "Mobile"

Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  


in reply to Lights out puzzle

Here's a quick Monday morning puzzle.
Quick?? I spent several hours on it, not being able to come with anything better then this: It's a bit randomized, but usually runs under 2 seconds on my machine. Run it with a filename as an argument to check the solution saved in the file.
Update: Removed forgotten debugging line.
Update2: Readmore changed to spoiler.

Replies are listed 'Best First'.
Re^2: Lights out puzzle
by choroba (Cardinal) on Nov 30, 2011 at 10:06 UTC
    Here are some comments on how it works:
    The code clears all the lines except for the last one (clean) the simple way: if there is a light, click underneath. The last line (or, better to say, broken line, i.e. the last line plus the remaining half of the previous one) is then solved half-randomly. At the beginning, I cache how clicking on the top line influences the last line, but only for one click on the line (i.e. I only know what the last line will be after having one light lit). Therefore, I have to click randomly until I get a cached position that I can solve. This works well for size 14, but the time doubles for each +2 in size, so size 20 is already too slow. Caching more positions could be added easily (like clicking two times), but I am not sure how much time it would take to cache all possible combinations on the first line.
    Because the order of clicks is not important, I keep a separate map of the board with 0 for the even clicks and 1 for the odd ones. This separate board is the output of the program.
Re^2: Lights out puzzle
by ambrus (Abbot) on Dec 01, 2011 at 10:41 UTC

    I changed the definition of the show and toggle methods like this:

    sub show { my $board = shift; print "\e[H"; for my $row (@$board) { return unless defined $row; print map $_ ? '*' : defined $_ ? '.' : '', @$row; print "\e[K\n"; } print "\e[J"; use Time::HiRes "sleep"; sleep(6e-3); } # show sub toggle { my ($board, $x, $y) = @_; my $old = $board->[$y][$x]; return unless defined $old; $board->[$y][$x] = $old eq 1 ? 0 : 1; } # toggle
    and now I can see the lights being chased down to the bottom of the board. Looks nice.
      Yes, in fact, I did something similar for debugging :-)