### Re: Lights out puzzle

by choroba (Bishop)
 on Nov 28, 2011 at 18:09 UTC ( #940423=note: print w/replies, xml ) Need Help??

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:
```#!/usr/bin/perl

package Board;

use warnings;
use strict;

use constant _CROSS => ([0, 0], [-1, 0], [1, 0], [0, -1], [0, 1]);

my %click;

sub new {
my (\$class, \$value) = @_;
my \$board = [];
@\$board = map [(\$value) x 14], 1 .. 13;
push @\$board, [(\$value) x 7];
\$click{refaddr(\$board)} = [map ([(0) x 14], 1 .. 13), [(0) x 7]];
bless \$board, \$class;
return \$board;
} # new

sub finished {
my \$board = shift;
return not grep {grep \$_, @\$_} @\$board;
} # finished

sub show {
my \$board = shift;
for my \$row (@\$board) {
return unless defined \$row;
print map \$_ ? '*' : defined \$_ ? '.' : '', @\$row;
print "\n";
}
} # show

sub _cross {
my (\$board, \$x, \$y) = @_;
my @cross = grep {
\$_->[0] >= 0
and \$_->[1] >= 0
and ref \$board->[\$_->[1]]
and defined \$board->[\$_->[1]][\$_->[0]]
} map [\$x + \$_->[0], \$y + \$_->[1]],
_CROSS;
return @cross;
} # _cross

sub toggle {
my (\$board, \$x, \$y) = @_;
my \$old = \$board->[\$y][\$x];
return unless defined \$old;
\$board->[\$y][\$x] = \$old eq 1 ? 0 : 1;
} # toggle

sub at {
my (\$board, \$x, \$y) = @_;
return if \$x < 0
or \$y < 0
or not ref \$board->[\$y]
or not defined \$board->[\$y][\$x];
return \$board->[\$y][\$x];
} # at

sub around {
my (\$board, \$x, \$y) = @_;
return map \$board->at(@\$_), \$board->_cross(\$x, \$y);
} # around

sub click {
my (\$board, \$x, \$y) = @_;
return unless defined \$board->[\$y][\$x];
+];
\$board->toggle(\$_->[0], \$_->[1])
for \$board->_cross(\$x, \$y);
} # click

sub row {
my (\$board, \$y) = @_;
return @{ \$board->[\$y] };
} # row

sub clean {
my \$board = shift;
for my \$y (1 .. 13) {
for my \$x (0 .. 13) {
\$board->click(\$x, \$y) if \$board->at(\$x, \$y-1);
}
}
} # clean

sub lastrow {
my \$board = shift;
return map \$board->at(\$_, 13 - (\$_ > 6)), (0 .. 13);
} # lastrow

sub history {
my \$board = shift;
return unless ref \$click{refaddr(\$board)};
my @h = @{ \$click{refaddr(\$board)} };
print map (\$_ ? 1 : '0', @\$_),"\n" for @h;
} # history

##########################################################

package main;

use warnings;
use strict;

sub stringify {
return join q[], map \$_ ? 1 : 0, @_;
} # stringify

if (@ARGV) {
my \$b = Board->new(1);
open my \$IN, '<', \$ARGV[0] or die \$!;
while (<\$IN>) {
chomp;
for my \$i (0 .. length()-1 ) {
\$b->click(\$i, \$.-1) if substr \$_, \$i, 1;
}
\$b->show;
}

} else {
my %cache;
for my \$i (0 .. 13) {
my \$b = Board->new(0);
\$b->click(\$i, 0);
\$b->clean;
my \$k = stringify(\$b->lastrow);
\$cache{\$k} = \$i;
}

delete \$cache{'0' x 14};

my \$board = Board->new(1);
while (1) {
\$board->clean;
my \$last = stringify(\$board->lastrow);
if (exists \$cache{\$last}) {
\$board->click(\$cache{\$last}, 0);
} elsif (not \$board->finished) {
\$board->click(int rand 13, int rand 2) for 1 .. 1 + int ra
+nd 5;
} else {
last;
}
}
\$board->history;
}
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 (Bishop) 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 :-)

Create A New User
Node Status?
node history
Node Type: note [id://940423]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (12)
As of 2019-10-18 13:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In 2019 the site I miss most is:

Results (45 votes). Check out past polls.

Notices?