+---+---+---+               +---+---+---+
|4..|...|8.5|               |417|369|825|
|.3.|...|...|               |632|158|947|
|...|7..|...|               |958|724|316|
+---+---+---+               +---+---+---+
|.2.|...|.6.|               |825|437|169|
|...|.8.|4..|               |791|586|432|
|...|.1.|...|               |346|912|758|
+---+---+---+               +---+---+---+
|...|6.3|.7.|               |289|643|571|
|5..|2..|...|               |573|291|684|
|1.4|...|...|               |164|875|293|
+---+---+---+               +---+---+---+

.6.5.4.3.1...9...8.........9...5...6.4.6.2.7.7...4...5.........4...8...1.5.2.3.4.
7.....4...2..7..8...3..8.799..5..3...6..2..9...1.97..6...3..9...3..4..6...9..1.35
....7..2.8.......6.1.2.5...9.54....8.........3....85.1...3.2.8.4.......9.7..6....

+---+---+---+       +---+---+---+       +---+---+---+
|.6.|5.4|.3.|       |7..|...|4..|       |...|.7.|.2.|
|1..|.9.|..8|       |.2.|.7.|.8.|       |8..|...|..6|
|...|...|...|       |..3|..8|.79|       |.1.|2.5|...|
+---+---+---+       +---+---+---+       +---+---+---+
|9..|.5.|..6|       |9..|5..|3..|       |9.5|4..|..8|
|.4.|6.2|.7.|       |.6.|.2.|.9.|       |...|...|...|
|7..|.4.|..5|       |..1|.97|..6|       |3..|..8|5.1|
+---+---+---+       +---+---+---+       +---+---+---+
|...|...|...|       |...|3..|9..|       |...|3.2|.8.|
|4..|.8.|..1|       |.3.|.4.|.6.|       |4..|...|..9|
|.5.|2.3|.4.|       |..9|..1|.35|       |.7.|.6.|...|
+---+---+---+       +---+---+---+       +---+---+---+

+---+---+---+
|...|.7.|.2.|
|8..|...|..6|
|.1.|2.5|...|
+---+---+---+
|9.5|4..|..8|
|...|...|...|
|3..|..8|5.1|
+---+---+---+
|...|3.2|.8.|
|4..|...|..9|
|.7.|.6.|...|
+---+---+---+
+-----------------------------+-----------------------------+-----------------------------+
|    56   |  34569  |   3469  |   1689  |    7    |  13469  |  13489  |    2    |   345   |
|    8    |  23459  |  23479  |    19   |   1349  |   1349  |  13479  |  134579 |    6    |
|    67   |    1    |  34679  |    2    |   3489  |    5    |  34789  |   3479  |   347   |
+-----------------------------+-----------------------------+-----------------------------+
|    9    |    26   |    5    |    4    |   123   |   1367  |   2367  |   367   |    8    |
|   1267  |   2468  |  124678 |  15679  |  12359  |  13679  |  234679 |  34679  |   2347  |
|    3    |   246   |   2467  |   679   |    29   |    8    |    5    |   4679  |    1    |
+-----------------------------+-----------------------------+-----------------------------+
|   156   |   569   |   169   |    3    |   1459  |    2    |   1467  |    8    |   457   |
|    4    |  23568  |  12368  |   1578  |   158   |    17   |  12367  |  13567  |    9    |
|   125   |    7    |  12389  |   1589  |    6    |   149   |   1234  |   1345  |   2345  |
+-----------------------------+-----------------------------+-----------------------------+

#!/usr/local/bin/perl
#
# Another sudoku solver with Perl!
#
# Programmer : Mohsen Safari
# Email      : safari.tafreshi@gmail.com
# Website     : dokaj.ir
#
# read sudoku tables from named file provided at command line
# or read it from standard input.
# each line has one sudoku challenge!
# blank entries must be specified with .(dot) or 0(zero).
# Examples:
#
# 4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......
# 52...6.........7.13...........4..8..6......5...........418.........3..2...87.....
# 6.....8.3.4.7.................5.4.7.3..2.....1.6.......2.....5.....8.6......1....
# 48.3............71.2.......7.5....6....2..8.............1.76...3.....4......5....
# ....14....3....2...7..........9...3.6.1.............8.2.....1.4....5.6.....7.8...
#
# Usage:
# $ echo 4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4...... | perl sudoku-solver.pl
# $ perl sudoku-solver.pl file
#

use warnings;
use strict;

my (@parray, @moves, @adjacent, %possibility_hash);
#
# A little house keeping! calculate each row, column, and sqaure indexs
# and finally calculate all adjacent of each entry.
#
{
    my (@rindex, @cindex, @sqindex);
    my (@r, @c, @sq);
    my ($r, $c, $sq);
    my (%hash, $j);
    # first index of each sqaure.
    my @sq_start = (0, 3, 6, 27, 30, 33, 54, 57, 60); 

    foreach(0 .. 8) {
        my @arr;
        for(my $iter = $_; $iter <= 80; $iter += 9){
            push @arr, $iter;
        }
        # fill indexes of each column.
        $cindex[$_] = [@arr];

        # Calculate indexes of each row.
        $rindex[$_] = [$_ * 9 .. $_ * 9 + 8];

        $j = $sq_start[$_];
        # fill indexes of each square
        $sqindex[$_] = [$j, $j+1,$j+2,$j+9,$j+10,$j+11,$j+18,$j+19,$j+20];
    }

    foreach(0 .. 80) {
        $r = int($_ / 9);
        $c = $_ % 9;

        if ($r <= 2) {
            if($c <= 2) { $sq = 0 } elsif ($c <= 5) { $sq = 1 } else { $sq = 2}
        }
        elsif ($r <= 5) {
            if($c <= 2) { $sq = 3 } elsif ($c <= 5) { $sq = 4 } else { $sq = 5}
        }
        else {
            if($c <= 2) { $sq = 6 } elsif ($c <= 5) { $sq = 7 } else { $sq = 8}
        }   

        @r  = @{$rindex[$r]};
        @c  = @{$cindex[$c]};
        @sq = @{$sqindex[$sq]};
        %hash = ();

        foreach my $j ((@r, @c, @sq)) {
            $hash{$j}++;
        }
        # fill adjacent indexes of each entry.
        $adjacent[$_] = [sort {$a <=> $b} keys %hash];
    }
}

#
# print sudoku table is a readable and familar format
#
sub print_sudoku {
    print "+---+---+---+", "\n";
    for (my $i = 0; $i <= $#parray; $i++) {
        if ( $i % 3 == 0) {
            print "|";
        }
        print $parray[$i] != 0 ? $parray[$i] : ".";
        print "|\n" if ( ($i + 1) % 9 == 0);

        if ( ($i + 1) % 27 == 0) {
            print "+---+---+---+", "\n";
        }
    }
}

#
# Print sudoku table. each entry that has not a specified value
# will be filled with its possible values.
#
sub display {
    find_possibilities(-1);
    print "+-----------------------------+-----------------------------+-----------------------------+" , "\n";
    for (my $i = 0; $i <= $#parray; $i++) {
        if ( $i % 9 == 0) {
            print "|";
        }
        if ($parray[$i] != 0) {
            print "    $parray[$i]    |";
        }
        else {
            my $b = $possibility_hash{$i};
            my $s = "";
            $s .= $_ foreach (@{$b});
            $s = " " . $s . " " while length $s < 9;
            $s = substr($s, 0, length($s) - 1) if length $s > 9;
            print $s, "|";
        }

        print "\n" if ( ($i + 1) % 9 == 0);

        if ( ($i + 1) % 27 == 0) {
            print "+-----------------------------+-----------------------------+-----------------------------+" , "\n";
        }
    }
}

#
# when no progress is available we would rollback to previous move
#
sub rollback {
    if (!@moves) {
        print STDERR "Moves array is empty!\n";
        exit 1;
    }

    my $r = pop @moves;
    $parray[$r->[0]] = 0;
    return ($r->[0], $r->[1]);
}

#
# find possibilities of each no valued entries.
#
sub find_possibilities {
    my (%hash, @arr, @tmp);
    my @iterate =  $_[0] == -1 ? (0 .. 80) : @{$adjacent[$_[0]]};

    delete @possibility_hash{@iterate};
    foreach my $i (@iterate) {
        next if $parray[$i] != 0;
        %hash = ();
        @arr = ();

        @tmp = @parray[@{$adjacent[$i]}];
        $hash{$_}++ foreach((@tmp));
        foreach (1..9) {
            push @arr, $_ if not exists $hash{$_};
        }       
        return -1 if !@arr;
        $possibility_hash{$i} = [@arr];
    }
    return 1;
}

#
# find best move at current position
#
sub find_best_move {
    my $spot_be = shift;
    my $must_not_be = shift;

    my (@su, @tmp);
    if ($spot_be >= 0) {
        foreach(@{$possibility_hash{$spot_be}}) {
            return ($spot_be, $_) if $_ > $must_not_be;
        }
        return (-1, -1); 
    }

    for(my $i = 0; $i <= $#parray; $i++) {
        next if $parray[$i] != 0;
        push @su, "$i @{$possibility_hash{$i}}";
    }
    @su = sort { length $a <=> length $b } @su;

    foreach my $i (@su){
        @tmp = split " ", $i;
        for (my $j = 1; $j <= $#tmp; $j++) {
            return ($tmp[0], $tmp[$j]) if $tmp[$j] != $must_not_be; 
        }
    }
    # if no move is available return (-1, -1) to rollback
    return (-1, -1);
}

my ($spot, $value, $try, $last);
my ($spot_be, $must_not_be) = (-1, -1);

#
# while there is a line at standard input or named file...
# each line is a sudoku.
#
while (<>) {
    chomp;
    if (length != 81) {
        print STDERR "Invalid sudoku entry!\n";
        next;
    }   
    s/\./0/g;
    @parray = split "";
    print_sudoku;
    display;
    $try = 0;
    $last = -1;
    while (1) {
        if (find_possibilities($last) == -1) {
            ($spot_be, $must_not_be) = rollback;
            $last = $spot_be;
            next;
        }
        last if !keys %possibility_hash;

        ($spot, $value) = find_best_move $spot_be, $must_not_be;
        if ($spot == -1 and $value == -1) {
            ($spot_be, $must_not_be) = rollback;
            $last = $spot_be;
            next;
        }
        $parray[$spot] = $value;
        push @moves, [$spot, $value];
        $spot_be = $must_not_be = -1;
        $try = $try + 1;
        $last = $spot;
    }
    print "Moves: $try\n";
    print_sudoku;
    print "@" x 13, "\n" if !eof();
}

$ head -n 1 top95.txt
4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......
$ head -n 1 top95.txt | perl sudoku-solver
+---+---+---+
|4..|...|8.5|
|.3.|...|...|
|...|7..|...|
+---+---+---+
|.2.|...|.6.|
|...|.8.|4..|
|...|.1.|...|
+---+---+---+
|...|6.3|.7.|
|5..|2..|...|
|1.4|...|...|
+---+---+---+
+-----------------------------+-----------------------------+-----------------------------+
|    4    |   1679  |  12679  |   139   |   2369  |   1269  |    8    |   1239  |    5    |
|  26789  |    3    | 1256789 |  14589  |  24569  | 1245689 |  12679  |   1249  |  124679 |
|   2689  |  15689  |  125689 |    7    |  234569 | 1245689 |  12369  |  12349  |  123469 |
+-----------------------------+-----------------------------+-----------------------------+
|   3789  |    2    |  135789 |   3459  |  34579  |   4579  |  13579  |    6    |  13789  |
|   3679  |  15679  |  135679 |   359   |    8    |  25679  |    4    |  12359  |  12379  |
|  36789  |  456789 |  356789 |   3459  |    1    |  245679 |  23579  |  23589  |  23789  |
+-----------------------------+-----------------------------+-----------------------------+
|   289   |    89   |   289   |    6    |   459   |    3    |   1259  |    7    |  12489  |
|    5    |   6789  |  36789  |    2    |   479   |  14789  |   1369  |  13489  |  134689 |
|    1    |   6789  |    4    |   589   |   579   |   5789  |  23569  |  23589  |  23689  |
+-----------------------------+-----------------------------+-----------------------------+
Moves: 481
+---+---+---+
|417|369|825|
|632|158|947|
|958|724|316|
+---+---+---+
|825|437|169|
|791|586|432|
|346|912|758|
+---+---+---+
|289|643|571|
|573|291|684|
|164|875|293|
+---+---+---+

$ cat hardest
8..........36......7..9.2...5...7.......457.....1...3...1....68.85...1...9....4..
..53.....8......2..7..1.5..4....53...1..7...6..32...8..6.5....9..4....3......97..
85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4.