implementation
Solving was harder, and I actually still haven't found a great way to do it.
# returns undef if the puzzle is complete # 0 if no pruning took place # n if N nodes were pruned # # If nodes are pruned, patience is reset # sub naked_ntuple { my ( $sobj, $curblock, %guesses ) = @_; my $pruned_nodes = 0; TUPLE: for my $tupleness ( 2, 3, 4 ) { next TUPLE unless keys %guesses == $tupleness; DIMENSION: for my $dim ( $sobj->{col}->[ $curblock->{col} ], $sobj->{row}->[ $curblock->{row} ], $sobj->{block}->[ $curblock->{block} ], ) { my @candidates = grep { ! $_->{known} } @$dim; my @tuples = grep { contain_only( $_, \%guesses ) } @candidates; next DIMENSION unless $tupleness == @tuples; ## just keep the name of the tuples @tuples = map { $_->{square} } @tuples; my @tupvals = sort keys %guesses; ## if we've seen this tuple, disregard ## a given tuple is only prunable once if ( $curblock->{tuple} ) { next DIMENSION if grep { array_eq( \@tuples, $_ ) } @{$curblock->{tuple}}; } # we thus have a naked n-tuple # and can prune keys %guesses from items not our tuple my %retain; @retain{@tuples} = @tuples; my @prunable = grep { !( $_->{known} || defined $retain{$_->{square}} ) and array_contains( $_->{guess}, \@tupvals ) } @$dim; next DIMENSION unless @prunable; PRUNE: for my $pruney ( @prunable ) { $pruney->{guess} = [ grep { ! $guesses{$_} } @{$pruney->{guess}} ]; next PRUNE if @{$pruney->{guess}} > 1; ## shortcut, and mark any solved squares as such if ( @{$pruney->{guess}} == 1 ) { return undef unless mark_known( $sobj, $pruney, $pruney->{guess}->[0] ); } else { ## TODO croak } } ## we've seen this tuple, and pruned all we can as a result push @{$curblock->{tuple}}, [ @tuples ]; } } return $pruned_nodes; }