Problems? Is your data what you think it is? PerlMonks

comment on

 Need Help??
```#!/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 board-type 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

In reply to Yet Another Sudoku Solver by SubStack

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

• 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.
• 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?

Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others scrutinizing the Monastery: (6)
As of 2020-10-23 11:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My favourite web site is:

Results (238 votes). Check out past polls.

Notices?