Do you know where your variables are? PerlMonks

### Yet Another Sudoku Solver

by SubStack (Monk)
 on Aug 26, 2006 at 18:31 UTC Need Help??
 Category: Fun Stuff Author/Contact Info SubStack Description: This script solves any sudoku puzzle that can be solved (as far as I can tell). I started out with a simpler version that only solved easy puzzles and then retro-fitted it to solve the harder ones where the player must follow out potentially useless trails. ```#!/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 ```
Replies are listed 'Best First'.
Re: Yet Another Sudoku Solver
by strat (Canon) on Jun 18, 2007 at 23:38 UTC
```9 6 7 4 3
4  2
7  23 1
5     1
4 2 8 6
3     5
3 7   5
7  5
4 5 1 7 8
only shows one solution (the sudoku has two):
```926571483
351486279
874923516
582367194
149258367
763194825
238749651
617835942
495612738
and
```926571483
351486279
874923516
582367194
149258367
763149825
238794651
617835942
495612738

Best regards,
perl -e "s>>*F>e=>y)\*martinF)stronat)=>print,print v8.8.8.32.11.32"

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://569825]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (1)
As of 2024-07-23 02:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.