note
choroba
<blockquote><i>Here's a quick Monday morning puzzle.</i></blockquote>
Quick?? I spent several hours on it, not being able to come with anything better then this:
<spoiler><c>
#!/usr/bin/perl
package Board;
use warnings;
use strict;
use Scalar::Util 'refaddr';
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];
$click{refaddr($board)}[$y][$x] = ! $click{refaddr($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 rand 5;
} else {
last;
}
}
$board->history;
}
</c></spoiler>
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.
<br><b>Update: </b>Removed forgotten debugging line.
<br><b>Update2: </b>Readmore changed to spoiler.
940327
940327