sudoku Puzzling in Perl #22

Nishimplemenation

sub nishio
{
  my ( $sobj, $round, %conf ) = @_;

  # find shortest guesslist:
  my @unknowns = grep { ! $_->{known} } @{ $sobj->{"square"} }; 
  @unknowns = sort { 
        scalar( @{$a->{guess}} ) <=> scalar( @{$b->{guess}} ) 
                   } @unknowns;

  my $key = shift @unknowns;

  my @solutions;   # if we are investigating ambiguity
  my $expense = $round;

  ASSUMPTION:
  for my $assumed ( @{ $key->{guess} } )
  {
     my $ass_obj = dclone $sobj;
     for ( $ass_obj->{"square"}->[ $key->{square} ] )
     {
        $_->{known} = 1;
        $_->{value} = $assumed;
     }

     $ass_obj->{patience} = GRIDSIZE * 2;

     my ( $success, $rec_round, @solved_objs ) = solve( $ass_obj, %conf );

     # stop when we succeed in finding a solution
     if ( $success )
     {
        return SUDOKU_SOLVED, $round + $rec_round, $solved_objs[0]
           unless $conf{AMBIGUOUS};

        $expense += $rec_round; 
        push @solutions, [ 1, $rec_round, $_ ]
           for @solved_objs;
     }
  }

  ## we arrive here in two cases: 
  #  - our recursion failed to find solutions
  #  - we are probing ambiguity

  if ( scalar @solutions )
  {
     # we found at least one solution
     if ( @solutions == 1 )
     {
        return SUDOKU_SOLVED, $expense, $solutions[0]->[2];
     } else {
        return SUDOKU_AMBIGUOUS, $expense, map { $_->[2] } @solutions;
     }

  } else {
     # we found no solutions
     return SUDOKU_UNSOLVABLE, $expense, undef;
  }
}
© fishbot