Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

a Perl solution for Sudoku puzzle

by pg (Canon)
on Aug 01, 2005 at 18:45 UTC ( [id://480007]=CUFP: print w/replies, xml ) Need Help??

This solution takes < 1 second to resolve a Sudoku: (I started with 25 seconds last night, as I used the first available blank instead of the blank spot with the least options.)

use Data::Dumper; use strict; use warnings; my $board = [ [undef, undef, 8, undef, undef, undef, undef, 4, undef +], [4, undef, undef, 2, 5, undef, undef, undef, 7], [undef, undef, undef, undef, undef, 7, 2, undef, 1], [undef, undef, undef, 9, undef, undef, undef, undef, 8 +], [1, undef, 6, 5, undef, 2, 9, undef, 3], [9, undef, undef, undef, undef, 1, undef, undef, undef +], [7, undef, 1, 6, undef, undef, undef, undef, undef], [8, undef, undef, undef, 2, 3, undef, undef, 6], [undef, 2, undef, undef, undef, undef, 4, undef, undef +] ]; my $t0 = time(); try($board); print "Took " . (time() - $t0) . " seconds\n"; sub try { my $board = shift; my ($x, $y, @options) = find_blank_with_least_options($board); if (defined($x)) { for (@options) { $board->[$x][$y] = $_; try($board); } $board->[$x][$y] = undef; } else { print "find solution:\n"; display($board); } } sub find_blank_with_least_options { my $board = shift; my ($x_to_return, $y_to_return, @options_to_return); my $least = 9; for my $x (0 .. 8) { for my $y (0 .. 8) { if (!defined($board->[$x][$y])) { my @options = (0,1,1,1,1,1,1,1,1,1); for (0 .. 8) { $options[$board->[$x][$_]] = 0 if defined($board-> +[$x][$_]); $options[$board->[$_][$y]] = 0 if defined($board-> +[$_][$y]); } for my $i (int($x/3) * 3 .. int($x/3) * 3 + 2) { for my $j (int($y/3) * 3 .. int($y/3) * 3 + 2) { $options[$board->[$i][$j]] = 0 if defined($boa +rd->[$i][$j]); } } my $sum; $sum += $options[$_] for (0 .. 9); if ($sum < $least) { $x_to_return = $x; $y_to_return = $y; $least = $sum; $#options_to_return = -1; for (1 .. 9) { push @options_to_return, $_ if ($options[$_]); } } } } } return ($x_to_return, $y_to_return, @options_to_return); } sub display { my $board = shift; for my $x (0 .. 8) { for my $y (0 .. 8) { print $board->[$x][$y] ? $board->[$x][$y] . " " : " "; } print "\n"; } }

Replies are listed 'Best First'.
Re: a Perl solution for Sudoku puzzle
by Taulmarill (Deacon) on Aug 02, 2005 at 08:29 UTC
    nice one :-)
    btw. is there already some code which is able to produce random puzzles?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://480007]
Approved by Grygonos
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (6)
As of 2024-04-24 06:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found