Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

SuDoKu solver

by Brovnik (Hermit)
on Dec 17, 2004 at 13:18 UTC ( #415620=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info richard-code@nuttall.uk.net
Description:
# VERSION 2 changes :
# - Now copes with more difficult puzzles
# - Lots more documentation
# - Clearer reporting
#
# Solver for SuDoKu puzzles.
# See enclosed Pod docs for more details.
# Uses Quantum::Superpositions to store partially known states.
# usage : ./solver < p1
# Where p1 is a SuDoKu puzzle.
# Example : (strip comment and leading whitespace)
#   ..21.64..
#   ..93875..
#   7...2...8
#   ..1...7..
#   .9..3..6.
#   ..5...8..
#   8...6...5
#   ..34786..
#   ..49.13..
#
# Rules are simple :
# Each column, row and 3*3 square contains the numbers 1..9
# once each.
# In the example above, some numbers are provided to help you.
# See also http://www.sudoku.co.uk
#! /usr/local/bin/perl

our $VERSION = '2.0.0';

use strict;
use warnings;
use Quantum::Superpositions;
use Getopt::Compact;
use Pod::Usage;

my $opt = new Getopt::Compact
(struct => [[[qw(v verbose)], qq(verbose mode, print grid after each i
+teration)],
            [[qw(q quiet)],   qq(quiet mode, just print result)],
            [[qw(s summary)], qq(print summary at end)],
            [[qw(m man)],     qq(Print Pod doc as man page)],
])->opts;

pod2usage(-verbose => 3) if $opt->{man};
my $init = any(1..9);
my $grid = # Setup - we know nothing !
[
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],

 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],

 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
 [$init,$init,$init, $init,$init,$init, $init,$init,$init],
];

my $known = 0; # How many cells do we know the value of ?

readpuzzle();
my $start = $known;
my $timer = time();
my $loops = 0;

#Keep looping round till there's no changes.
printgrid() while (elimrows() + elimcols() + elimsquares() and $known 
+< 81);

$known == 81 ? finalgrid() : printgrid(1);
if ($opt->{summary})
{
   my $elapsed = time() - $timer;
   print "Solved in $elapsed secs. with $loops iterations over the gri
+d.\n";
   print "Initial grid $start, finished $known\n";
}
exit;
# That's the end of the main code, rest are supporting subroutines.

# For each row, collect the known values and eliminate those values fr
+om the
# states of the other cells
sub elimrows
{
   my $changed = 0;
   $loops++;
   for my $row (0..8)
   {
      my ($known,$seen) = gather($row,0,'row');
      for my $col (0..8)
      {
         my $cell = $grid->[$row][$col];
         # Eliminate all known values from this cell's state
         my $to = $cell != all(@$known);
         next if eigenstates($cell) == 1;
         if (eigenstates($cell) > 1 and eigenstates($cell) > eigenstat
+es($to))
         {
            # We have reduced the eigenstates of a cell, so record thi
+s.
            $changed++;
            record($row,$col,$to,'Row elimination');
            # If there's now only one possible state for this cell, we
+ have a new known value.
         }
         elsif (eigenstates($cell) > 1)
         {
            for (eigenstates($cell))
            {
               record($row,$col,$_,'Row only option') if ($seen->{$_} 
+== 1);
               # This is the only cell that can have this value, so se
+t it.
            }
         }
      }
   }
   return $changed;
}


# For each column, collect the known values and eliminate those values
+ from the
# states of the other cells
sub elimcols
{
   my $changed = 0;
   for my $col (0..8)
   {
      my ($known,$seen) = gather(0,$col,'column');
      for my $row (0..8)
      {
         my $cell = $grid->[$row][$col];
         next if eigenstates($cell) == 1;
         my $to = $cell != all(@$known);
         if (eigenstates($cell) > 1 and eigenstates($cell) > eigenstat
+es($to))
         {
            $changed++;
            record($row,$col,$to,'Column elimination');
         }
         elsif (eigenstates($cell) > 1)
         {
            for (eigenstates($cell))
            {
               record($row,$col,$_,'Column only option') if ($seen->{$
+_} == 1);
               # This is the only cell that can have this value, so se
+t it.
            }
         }
      }
   }
   return $changed;
}

# As above but for 3*3 square
sub elimsquares
{
   my $changed = 0;
   for my $row (0..8)
   {
      for my $col (0..8)
      {
         my ($known,$seen) = gather($row,$col,'square');
         my $cell = $grid->[$row][$col];
         next if eigenstates($cell) == 1;
         my $to = $cell != all(@$known);
         if (eigenstates($cell) > 1 and eigenstates($cell) > eigenstat
+es($to))
         {
            $changed++;
            record($row,$col,$to,'Square elimination');
         }
         elsif (eigenstates($cell) > 1)
         {
            for (eigenstates($cell))
            {
                record($row,$col,$_,'Square only option') if ($seen->{
+$_} == 1);
            }
         }
      }
   }
   return $changed;
}


sub readpuzzle
{
   for my $row (0..8)
   {
      my $line = <>;
      chomp($line);
      my @row = split //, $line;
      for my $col (0..8)
      {
         my $cell = shift(@row);
         next if $cell eq '.';
         $grid->[$row][$col] = $cell;
         $known++;
      }
   }
}

sub printgrid
{
   return unless shift or $opt->{verbose};
   print "\n   ";
   printf "%-9s " ,$_ for (qw(A B C D E F G H I));
   print"\n";
   my $rc = 1;
   foreach my $row (@$grid)
   {
      print $rc++, ") ";
      map {printf "%-9s " , join('',sort(eigenstates($_)))} @$row;
      print "\n";
   }
   print "\n";
}

sub finalgrid
{
   print "\nCompleted : \n\n";
   print join('',@$_), "\n" for (@$grid);
   print "\n";
}

sub record
{
   my ($row,$col,$to,$type) = @_;
   my $state  = state($row,$col);
   $grid->[$row][$col] = $to;
   # We have recorded the reduced eigenstates, but only report if new 
+known value.
   return unless eigenstates($to) == 1;
   printf("%-14s => %d by %s\n",$state,$to,$type) unless $opt->{quiet}
+;
   $known++;
}

# User friendly Column/Row indication.
sub loc
{
   my ($row,$col) = @_;
   return sprintf('%s%d',chr(ord('A')+$col),$row+1);
}

# User friendly Column/Row indication and state
sub state
{
   my ($row,$col) = @_;
   return sprintf('%s=any(%s)',loc($row,$col),join('',sort(eigenstates
+($grid->[$row][$col]))));
}

# Returns (\@known,\%seen)
# @known is an array of the known values in the row/column/square (cel
+ls with only one possible state)
# %seen is a hash of times that each number occurs in the states of ot
+her cells in the row/column/square,
# but NOT counting the known states.
sub gather
{
   my ($row,$col,$type) = @_;
   my @known = ();
   my %seen = ();
   $seen{$_} = 0 for (1..9);

   if ($type eq 'square')
   {
      #print "Gather Square " . loc($row,$col) . " => ...";
      for my $r (0..2)
      {
         for my $c (0..2)
         {
            #printf '%s, ',state(3*int($row / 3)+$r,3*int($col / 3)+$c
+);
            my $cell = $grid->[3*int($row / 3)+$r][3*int($col / 3)+$c]
+;
            eigenstates($cell) == 1 ?  push (@known,$cell) : $seen{$_}
+++ for (eigenstates($cell));
         }
      }
      #print "\n";
   }
   elsif ($type eq 'row')
   {
      for my $col (0..8)
      {
         my $cell = $grid->[$row][$col];
         eigenstates($cell) == 1 ?  push (@known,$cell) : $seen{$_}++ 
+for (eigenstates($cell));
      }
   }
   elsif ($type eq 'column')
   {
      for my $row (0..8)
      {
         my $cell = $grid->[$row][$col];
         eigenstates($cell) == 1 ?  push (@known,$cell) : $seen{$_}++ 
+for (eigenstates($cell));
      }
   }
   # Don't count states where we already have a known value (These mul
+tiple occurances are about to
   # be eliminated in the calling function)
   $seen{$_} = 0 for @known;
   return (\@known,\%seen); 
}

__END__

=head1 NAME

SuDoKu Solver

=head1 VERSION

This document describes the version released 28-Dec-04

=head1 SYNOPSIS

sudoku h3.sud
   -h, --help      This help message                            
   -v, --verbose   Verbose mode, print grid after each iteration
   -q, --quiet     Quiet mode, just print result                
   -s, --summary   Print summary at end                         
   -m, --man       Print Pod doc as man page                    

=head1 BACKGROUND

This is a solver for SuDoKu puzzles. SuDoKu puzzles
are a 9*9 grid of numbers. At the start, some are provided
for you. Your challenge is to find the initially unknown
values.

=head2 Puzzle File input format

 ..21.64..
 ..93875..
 7...2...8
 ..1...7..
 .9..3..6.
 ..5...8..
 8...6...5
 ..34786..
 ..49.13..

=head2 Rules

 Each column, row and 3*3 square contains the numbers 1..9
 once each.

=head1 How to solve a SuDoKu puzzle

Iterate over each cell in the grid

=head2 Elimination

=over 

=item Pick a cell.

=item Check the same Column, Row and 3*3 Square (CRS). None 
of the known values in the same CRW can be in this cell.

=item If that only leaves us one possible value, we have a new known v
+alue.

=back

=head2 the "Only" option

=over

=item For a given CRS, look at the possible values for each cell witho
+ut
 a known state.

=item If one of the possibilities occurs only once in the CRS (and is
 not an existing known value, ) then the cell where it is a possibilit
+y
 must have that value, giving us a new known value.

=back 

 Finding a new known cell value will reduce the possbilities for
 other unknown states in the same CRS as the newly discovered cell.
 Iterate, checking each cell until solved.

=head1 AUTHOR

Richard Nuttall (richard-code@nuttall.uk.net)

=head1 COPYRIGHT

Copyright (c) 2004, Richard Nuttall
ll Rights Reserved.

This module is free software. It may be used, redistributed
and/or modified under the stame terms as Perl-5.8.0 (or later)
(see http://www.perl.com/perl/misc/Artistic.html).

=head1 BUGS

This solver only works for puzzles that can be determined by logic alo
+ne.
If it is given a puzzle with insufficient, or inconsistent clues, or o
+ne
that requires backtracking, it will fail.

=cut

Comment on SuDoKu solver
Download Code
Re: SuDoKu solver
by NetWallah (Abbot) on Jul 18, 2005 at 03:32 UTC
    Cool code (++)!

    I was attempting to re-write the $grid array-ref initialization in a more "Lazy" manner, using the "x" operator, but the implementation of that operator optimizes in such a way that the operand gets evaluated only once. I had to settle on "map" :

    my $grid=[ map {[ map {$init} 1..9 ]} 1..9 ];
    If anyone can accomplish this using the "x" operator in a non-obfu way, I'd love to hear it.

         "Income tax returns are the most imaginative fiction being written today." -- Herman Wouk


      I initially wrote this and it appeared correct according to Test::More::is_deeply(). However, despite the test, it is wrong since the inner array ref is copied rather than recreated (which is probably what you are alluding to above).
      my $grid = [([($init) x 9]) x 9]; # ! wrong

      So, perhaps somethings like this:

      my $grid = [map {[($init) x 9]} 1..9];

      I was really addicted to Sudoku puzzles a few weeks ago, but I'm finally getting my life back. :-)

      --
      John.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://415620]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (8)
As of 2014-09-22 19:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (198 votes), past polls