#!/usr/bin/perl
# solve.pl  Solves all sudoku puzzles, even really hard ones
# Just feed it a file with each row on a line and spaces for the blank
+s.
use strict;
use warnings;
use Storable qw(dclone);
my $DEBUG = 0;
die "usage: $0 file\n" unless @ARGV;
open my $fh, "<", $ARGV[0] or die "failed to open '$ARGV[0]': $!\n";
# Store all potential squares (by which I mean the boardtype thing).
# This grows as new potentials solutions manifest and shrinks as they
+fail.
my @squares = [ map [ m/([\d ])/g ], <$fh> ];
# Number of potential solutions that will be acceptable for the given
+search.
# This is automatically adjusted based on the availability of good sol
+utions.
my $threshold = 1;
close $fh;
# Iternate through each spot and see how many choices for numbers ther
+e are.
# If the number of choices meets the threshold, fill the coordinate in
+, on
# multiple instances of the square if needed.
scan: while (grep $_ eq " ", map @$_, @{$squares[0]}) {
# keep track of y coordinate on the square
my $y = 1;
for my $row (@{$squares[0]}) {
$y++;
# keep track of x coordinate on the square
my $x = 1;
for my $number (@$row) {
$x++;
next unless $number eq " "; # only bother solving blank squares
# Load all the numbers in the coordinate's 3x3 magic square.
# They aren't really magic squares of course, but it makes them
+easier to
# refer to.
my @magic = grep $_ ne " ",
map @{$_}[int($x / 3) * 3 .. int($x / 3) * 3 + 2 ],
@{$squares[0]}[int($y / 3) * 3 .. int($y / 3) * 3 + 2];
# Load all the numbers in the coordinate's row.
my @row_nums = grep $_ ne " ", @$row;
# Load all the numbers in the coordinate's column.
my @col_nums = grep $_ ne " ", grep defined, map $_>[$x], @{$sq
+uares[0]};
# Count up the occurances of the numbers the coordinate can't be
+.
my %count = map { $_ => 0 } 1 .. 9;
$count{$_}++ for @magic, @row_nums, @col_nums;
# All the possible values for the coordinate
my @possible = grep $count{$_} == 0, keys %count;
print "($x, $y): ",
" possible = @{[ sort @possible ]}\n",
" magic = @{[ sort @magic ]}\n",
" cols = @{[ sort @col_nums ]}\n",
" rows = @{[ sort @row_nums ]}\n"
if $DEBUG;
if (@possible == $threshold) {
# Number of possibilities meets the threshold
print "Solved coordinate ($x, $y) == (@possible)\n" if $DEBUG;
# Throw the first possibility onto the current square.
$squares[0][$y][$x] = shift @possible;
for (@possible) {
# Throw the other possibilities into copies of the current s
+quare.
push @squares, dclone($squares[0]);
$squares[$#squares][$y][$x] = $_;
}
# Set the threshold back to 1 for a successful match.
$threshold = 1;
next scan;
}
# Scrap squares that don't have any possible choices for a parti
+cular
# coordinate.
if (@possible == 0) {
print "Scrapping guess due to ($x, $y)\n" if $DEBUG;
shift @squares;
die "No more guesses! Unsolvable!\n" unless @squares;
$threshold = 1;
next scan;
}
}
}
# The possibilities weren't good enough. Be less picky next iteratio
+n.
$threshold++;
}
show(0);
sub show { # useful for debugging the squares while running
print join("", @$_), "\n" for @{$squares[$_[0]]};
}
Spaces are used for blanks. Here's an example to try out:
9 4
7 6
89 21
36 8
42 67
9 68
61 54
8 7
4 1
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
 a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

For: 

Use: 
 &   & 
 <   < 
 >   > 
 [   [ 
 ]   ] 
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.

