gistfile1.ph

#!/usr/bin/perl

package Sudoku;
use strict;
use warnings;

sub new {
    my $pkg = shift;
    my $self = bless {}, $pkg;
    $self->load_puzzle(@_) if @_;
}

sub load_puzzle {
    my $self = shift;
    my ($puzzle) = @_;
    my $cells = [];
    my @rows = grep { $_ } split /\n/, $puzzle;
    die "Invalid puzzle @rows" if scalar @rows != 9;
    for my $row ( @rows ) {
        $row =~ s/[^1-9\-\.]//g;
        die "Invalid row [$row]" if 9 != length $row;
        $row =~ s/\./\-/g;
        push @$cells, [ split //, $row ];
    }
    $self->{cells} = $cells;
    $self;
}

sub answer {
    my $self = shift;

    my $cells = $self->{cells};
    my $i = 1;
    my @voids;
    for my $row ( @$cells ) {
        for my $cell ( @$row ) {
            push @voids, \$cell if $cell eq '-';
        }
    }
    printf "Try to fill %s void cells\n", scalar @voids;
    $self->_answer_core( \@voids, 0 );
}

sub _answer_core {
    my $self = shift;
    my ( $voids, $depth ) = @_;
    my $this = shift @$voids;
    TRY: for my $try ( 1..9 ) {
        $$this = $try;
        my $flag = $self->_is_cleared;
        if ( 1 == $flag ) {
            print STDERR $self->_print;
            exit;
        }
        elsif ( 1 < $flag ) {
            next TRY;
        }
        else {
            $self->_answer_core( $voids, $depth + 1 );
        }
    }
    $$this = '-';
    unshift @$voids, $this;
}

## returns
#    0: valid but not yet cleared
#    1: cleared
#    2: invalid
sub _is_cleared {
    my $self = shift;
    my $cells = $self->{cells};
    my $cleared = 1;
    for my $i ( 0..8 ) {
        my %chk_r;
        for my $j ( 0..8 ) {
            if ( $cells->[$i][$j] =~ m/[^1-9]/ ) {
                $cleared = 0;
                next;
            }
            return 2 if $chk_r{ $cells->[$i][$j] };
            $chk_r{ $cells->[$i][$j] }++;
        }
        my %chk_c;
        for my $j ( 0..8 ) {
            if ( $cells->[$j][$i] =~ m/[^1-9]/ ) {
                $cleared = 0;
                next;
            }
            return 3 if $chk_c{ $cells->[$j][$i] };
            $chk_c{ $cells->[$j][$i] }++;
        }
        my %chk_b;
        for my $j ( 0..8 ) {
            my ( $x, $y );
            $x = ( int( $i % 3 ) * 3 ) + ( $j % 3        );
            $y = ( int( $i / 3 ) * 3 ) + ( int( $j / 3 ) );
            if ( $cells->[$x][$y] =~ m/[^1-9]/ ) {
                $cleared = 0;
                next;
            }
            return 4 if $chk_b{ $cells->[$x][$y] };
            $chk_b{ $cells->[$x][$y] }++;
        }
    }
    return $cleared;
}

sub _print {
    my $self = shift;
    my $cells = $self->{cells};
    my $out;
    my $i = 1;
    for my $row ( @$cells ) {
        my $line = '';
        my $j = 1;
        for my $cell ( @$row ) {
            $line .= $cell;
            $line .= " " unless $j++ % 3;

        }
        $out .= "$line\n";
        $out .= "\n" unless $i++ % 3;
    }
    $out;
}

package main;
use strict;
use warnings;

my $pzl = <<'EOT';
-45 --- 68-
6-- -8- --9
-7- 9-1 -3-

--7 -3- 8--
2-- --- --6
--1 -2- 7--

-2- 5-6 -1-
1-- -9- --2
-56 --- 94-
EOT

my $sdk = Sudoku->new($pzl);
print $sdk->answer();