Commits

Anonymous committed ecd8f50

Added the _solve_using_distance_from_islands() method.

Comments (0)

Files changed (3)

nurikabe-solver/Games-Nurikabe-Solver/lib/Games/Nurikabe/Solver/Board.pm

     return $self->_flush_moves();
 }
 
+sub _solve_using_distance_from_islands
+{
+    my $self = shift;
+
+    # Mark non-traversable cells - these are cells that are too close 
+    # to a white island cell.
+    foreach my $island (@{$self->_islands()})
+    {
+        my $non_traverse = $island->surround({board => $self });
+
+        foreach my $coords (@$non_traverse)
+        {
+            $self->get_cell(@$coords)->island_in_proximity($island->idx());
+        }
+    }
+
+    # Now do a Breadth-First Search scan for every island and mark the
+    # islands reachable by it.
+
+    foreach my $island (@{$self->_islands()})
+    {
+        my @queue = (map { [0,$_] } @{$island->known_cells()});
+
+        my $dist_limit = $island->order() - @{$island->known_cells()};
+
+        QUEUE_LOOP:
+        while (@queue)
+        {
+            my $item = shift(@queue);
+            
+            my ($dist, $c) = @$item;
+
+            if ($dist == $dist_limit)
+            {
+                next QUEUE_LOOP;
+            }
+            
+            OFFSET_LOOP:
+            foreach my $offset ([-1,0],[0,-1],[0,1],[1,0])
+            {
+                my $to_check = $self->add_offset($c, $offset);
+
+                if (!$self->_is_in_bounds(@$to_check))
+                {
+                    next OFFSET_LOOP;
+                }
+
+                my $cell = $self->get_cell(@$to_check);
+
+                if (($cell->status() eq $NK_BLACK)
+                    || (defined($cell->island()) 
+                        && $cell->island() != $island->idx()
+                    )
+                )
+                {
+                    next OFFSET_LOOP;
+                }
+
+                if (defined($cell->island_in_proximity()) &&
+                    $cell->island_in_proximity() != $island->idx()
+                )
+                {
+                    next OFFSET_LOOP;
+                }
+
+                push @queue, $cell->set_island_reachable(
+                    $island->idx(),
+                    $dist+1,
+                    $to_check
+                );
+            }
+        }
+    }
+
+    # Now mark the unreachable states.
+    $self->_cells_loop(
+        sub {
+            my ($coords, $cell) = @_;
+
+            if ($cell->status() eq $NK_UNKNOWN && ! $cell->_reachable())
+            {
+                $self->_mark_as_black(@$coords);
+            }
+        },
+    );
+
+    $self->_add_move(
+        {
+            reason => "distance_from_islands",
+        }
+    );
+
+    return $self->_flush_moves();
+}
+
 =head1 AUTHOR
 
 Shlomi Fish, C<< <shlomif at cpan.org> >>

nurikabe-solver/Games-Nurikabe-Solver/lib/Games/Nurikabe/Solver/Cell.pm

 use warnings;
 use strict;
 
-use base 'Class::Accessor';
+use base 'Games::Nurikabe::Solver::Base';
 use base 'Exporter';
 
 =head1 NAME
 __PACKAGE__->mk_accessors(qw(
     status
     island
+    island_in_proximity
+    _reachable
+    _island_reachable
     ));
 
 =head1 SYNOPSIS
 
 our @EXPORT_OK = (qw($NK_BLACK $NK_WHITE $NK_UNKNOWN));
 
+sub _init
+{
+    my $self = shift;
+    my $args = shift;
+
+    $self->status($args->{status});
+    $self->island($args->{island});
+    $self->_reachable(0);
+    $self->_island_reachable([]);
+
+    return 0;
+}
+
 =head2 my $bool = $self->belongs_to_island()
 
 Returns true if the cell is white and belongs to an island (i.e: it isn't
     );
 }
 
+=head2 $self->set_island_reachable($island_idx, $distance, $coords)
+
+Sets the island-related reachable distance from $island_idx. If we already
+have a suitable distance (lower or equal) - does nothing and returns false.
+
+Else sets and returns the [$distance, $coords] of the new point.
+
+=cut
+
+sub set_island_reachable
+{
+    my ($self, $island, $dist, $c) = @_;
+
+    if (defined($self->_island_reachable->[$island]) &&
+        ($self->_island_reachable->[$island] <= $dist)
+    )
+    {
+        return;
+    }
+
+    $self->_island_reachable->[$island] = $dist;
+    $self->_reachable(1);
+
+    return ([$dist, $c]);
+}
+
 =head1 AUTHOR
 
 Shlomi Fish, C<< <shlomif at cpan.org> >>

nurikabe-solver/Games-Nurikabe-Solver/t/solve1.t

 use strict;
 use warnings;
 
-use Test::More tests => 57;
+use Test::More tests => 58;
 
 use Test::Differences;
 
 use Games::Nurikabe::Solver::Cell qw($NK_UNKNOWN $NK_WHITE $NK_BLACK);
 use Games::Nurikabe::Solver::Board;
 
+use List::MoreUtils qw(any);
+
 {
     my $string_representation = <<"EOF";
 Width=2 Height=2
         eq_or_diff ($moves, [], "No more moves left.");
     }
 }
+
+{
+    # http://www.logicgamesonline.com/nurikabe/archive.php?pid=981
+    # Daily 9*9 Nurikabe for 2008-10-01
+    my $string_representation = <<"EOF";
+Width=9 Height=9
+[]  []  []  []  []  [3] []  []  []
+[]  [1] []  [5] []  []  []  []  []
+[]  []  []  []  []  []  []  []  []
+[]  []  []  []  [1] []  []  []  []
+[]  []  []  []  []  []  []  []  []
+[]  []  []  []  [6] []  []  []  []
+[]  []  []  []  []  []  []  []  []
+[]  []  []  []  []  [8] []  [7] []
+[]  []  []  [2] []  []  []  []  []
+EOF
+
+    my $board =
+        Games::Nurikabe::Solver::Board->load_from_string(
+            $string_representation
+        );
+
+    {
+        my $moves = $board->_solve_using_distance_from_islands({});
+
+        # TEST
+        ok(
+            (any { 
+                my $m = $_;
+                $m->reason("distance_from_islands") &&
+                (any { $_->[0] == 7 && $_->[1] == 0 } 
+                @{$m->get_verdict_cells($NK_BLACK)})
+            } (@$moves)),
+            "Marked Cells contain (7,0)",
+        );
+    }
+}