Anonymous avatar Anonymous committed e1b1d51

Add the _solve_using_fully_expand_island move.

Comments (0)

Files changed (3)

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

     return $self->_actual_mark($c,$NK_BLACK);
 }
 
+sub _mark_as_white
+{
+    my ($self, $c, $idx) = @_;
+
+    my $cell = $self->get_cell($c);
+
+    if ($cell->status() eq $NK_BLACK)
+    {
+        die "Cell ($c->[0],$c->[1]) should not be black but it is";
+    }
+
+    if ($cell->status() eq $NK_WHITE)
+    {
+        # Do nothing - it's already black.
+        return;
+    }
+
+    $cell->island($idx);
+
+    $self->_found_totals()->{$NK_WHITE}++;
+    $self->_found_totals()->{$NK_UNKNOWN}--;
+
+    return $self->_actual_mark($c,$NK_WHITE);
+}
+
 sub _cells_loop
 {
     my ($self, $callback) = @_;
     }
 
     # Now do a Breadth-First Search scan for every island and mark the
-    # islands reachable by it.
+    # cells reachable by it.
 
     foreach my $island (@{$self->_islands()})
     {
     return;
 }
 
+sub _solve_using_fully_expand_island
+{
+    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
+    # cells reachable by it.
+
+    foreach my $island (@{$self->_islands()})
+    {
+        $island->mark_reachable_brfs_scan({board => $self});
+    }
+
+    my @island_reachable_cells = (map { [] } @{$self->_islands()});
+
+    # Now mark the unreachable states.
+    $self->_cells_loop(
+        sub {
+            my ($coords, $cell) = @_;
+
+            if (($cell->status() eq $NK_UNKNOWN)
+                && $cell->_reachable()
+            )
+            {
+                foreach my $idx (0 .. $#{$self->_islands()})
+                {
+                    if (defined($cell->_island_reachable->[$idx]))
+                    {
+                        push @{$island_reachable_cells[$idx]}, [@$coords];
+                    }
+                }
+            }
+        },
+    );
+
+    my $moved = 0;
+
+    foreach my $idx (0 .. $#{$self->_islands()})
+    {
+        my $island = $self->_islands->[$idx];
+
+        my $count = @{$island_reachable_cells[$idx]} + @{$island->known_cells};
+
+        # We can mark all these cells as white, since the island is full.
+        if ($count == $island->order())
+        {
+            $moved = 1;
+            $island->add_white_cells({
+                    board => $self,
+                    cells => $island_reachable_cells[$idx]
+                }
+            );
+        }
+    }
+
+    if ($moved)
+    {
+        $self->_add_move(
+            {
+                reason => "fully_expand_island",
+            }
+        );
+    }
+
+    return;
+}
+
 sub _solve_using
 {
     my $self = shift;

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

     return;
 }
 
+=head2 $island->add_white_cells( { board => $board, cells => [@list],} )
+
+Add these cells now known as white to the island.
+
+=cut
+
+sub add_white_cells
+{
+    my ($self, $args) = @_;
+
+    my $board = $args->{'board'};
+    my $new_cells = $args->{'cells'};
+
+    foreach my $coord (@$new_cells)
+    {
+        push @{$self->known_cells()}, [@$coord];
+        $board->_mark_as_white($coord, $self->idx);
+    }
+
+    $self->known_cells($self->_sort_coords($self->known_cells()));
+
+    return;
+}
+
+
 =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 => 78;
+use Test::More tests => 80;
 
 use Test::Differences;
 
        ;
 }
 
+sub in_white
+{
+    my ($self, $coords) = @_;
+    
+    return (any { $_->[0] == $coords->[0] && $_->[1] == $coords->[1] }
+           @{$self->move->get_verdict_cells($NK_WHITE)})
+       ;
+}
+
+sub multi_in_white
+{
+    my ($self, $list_of_coords) = @_;
+
+    my @not_found = (grep { !$self->in_white($_) } @$list_of_coords);
+
+    if (! @not_found)
+    {
+        return '';
+    }
+    else
+    {
+        return 'Coordinates [ ' . 
+            join(" , ", map { '['.join(',',@$_) . ']' } @not_found)
+            . ' ] were not marked as white in this move.'
+            ;
+    }
+}
+
 sub reason
 {
     my $self = shift;
         );
     }
 }
+
+{
+    # http://www.logicgamesonline.com/nurikabe/archive.php?pid=981
+    # Daily 9*9 Nurikabe for 2008-10-01
+    my $string_representation = <<"EOF";
+Width=5 Height=5
+[] [6] [] [] []
+[] [] [] [2] []
+[] [] [] [] []
+[] [1] [] [] []
+[] [] [] [2] []
+EOF
+
+    my $board =
+        Games::Nurikabe::Solver::Board->load_from_string(
+            $string_representation
+        );
+
+    $board->_solve_using(
+        {
+            name => "surround_island",
+            params => {},
+        }
+    );
+
+    $board->_solve_using(
+        {
+            name => "surrounded_by_blacks",
+            params => {},
+        }
+    );
+
+    $board->_solve_using(
+        {
+            name => "distance_from_islands",
+            params => {},
+        }
+    );
+
+    my $moves = $board->_solve_using(
+        {
+            name => "fully_expand_island",
+            params => {},
+        }
+    );
+
+    my $m = MyMove->new({move => shift(@$moves)});
+
+    # TEST
+    eq_or_diff(
+        $moves,
+        [],
+        "No remaining moves except the first one."
+    );
+
+    my $verdict = $m->multi_in_white([[0,0],[0,2],[1,0],[1,1],[2,0]]);
+
+    # TEST
+    if (! ok (!$verdict, "All fully_expand_island white cells are there."))
+    {
+        diag($verdict);
+    }
+}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.