#! /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 iteration)],
            [[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 grid.\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 from 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) > eigenstates($to))
         {
            # We have reduced the eigenstates of a cell, so record this.
            $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 set 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) > eigenstates($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 set 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) > eigenstates($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 (cells with only one possible state)
# %seen is a hash of times that each number occurs in the states of other 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 multiple 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 value.

=back

=head2 the "Only" option

=over

=item For a given CRS, look at the possible values for each cell without
 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 possibility
 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 alone.
If it is given a puzzle with insufficient, or inconsistent clues, or one
that requires backtracking, it will fail.

=cut