#!/usr/local/bin/perl -w
#
# Copyright (c) 2005, John Gillman
# All rights reserved
#
# This program is free software. It may be used, re-distributed
# and/or modified under the same terms as Perl 5.8.0 (or later),
# (see http://www.perl.com/perl/misc/Artistic.html).
#
# Force pre-declaration, import Term::ANSIColor to allow bold text
# so as to make printed representations of the puzzle grid more
# readable.
#
use strict;
use Term::ANSIColor qw(:constants);

# Check that we have a single argument which is the name of the
# file containing the puzzle data, i.e which cells have numbers
# and which don't. (And what the numbers are, obviously.)
#
die "usage: sudoku filename\a\n" unless scalar @ARGV == 1;
die "sudoko: $ARGV[0] does not exist\a\n" unless -e $ARGV[0];

# Set up formatting components using the Term::ANSIColor constants
# to embolden certain parts so as to replicate the puzzle grid as
# it appears in the newspaper.
#
our $leftEdge = " " . BOLD . "|" . RESET;
our $boldLight = BOLD . "~~~~~" . RESET . "|";
our $boldBold = BOLD . "~~~~~|" . RESET ;
our $lightBold = "-----" . BOLD . "|" . RESET;
our $lightLight = "-----|";
our $spaceBold = "     " . BOLD . "|" . RESET;
our $spaceLight = "     |";

# Use the components to construct row and column separator lines.
#
our $boldRowSep = $leftEdge . ($boldLight x 2 . $boldBold) x 3 . "\n";
our $lightRowSep = $leftEdge . ($lightLight x 2 . $lightBold) x 3 . "\n";
our $colSep = $leftEdge . ($spaceLight x 2 . $spaceBold) x 3 . "\n";

# Initialise puzzle grid to 9 rows and 9 columns of spaces and
# initialise count of solutions found. Puzzle grid is a list of
# lists, columns within rows.
#
our $rlGrid = [];
{
    my @row = ();
    push @row, ' ' for 0 .. 8;
    @{$rlGrid->[$_]} = @row for 0 .. 8;
}
our $solnCt = 0;

# Set up a hash table with, initially, an entry for each cell, the
# key being "row:column". When a cell is filled, it's corresponding
# entry in the hash is deleted.
#
our $rhEmpties = {};
foreach my $row (0 .. 8)
{
    foreach my $col (0 .. 8)
    {
        $rhEmpties->{"$row,$col"} = [];
    }
}

# Open the input file for reading.
#
our $inputFile = shift;
open IN, "<$inputFile" or die "open: $inputFile: $!\n";

# Declare another grid to hold locations in the grid where numbers
# were placed at the start, declare an anonymous hash that will hold
# locations of empty cells and declare an anonymous hash that will
# hold a list of keys of empty cells in each group of nine. Read
# data lines at the end of the script one at a time. There should
# be nine lines, one for each row, and each line should contain nine
# characters, one for each column with the digits 1 through 9 and
# dots representing blank cells.
#
our $rlInitialNos = [];
our $rhEmptyCells = {};
our $rhAffected = {};
while(<IN>)
{

    # Validate input; are there more than nine lines? Drop newline
    # and check we have exactly nine valid characters.
    #
    die "Only nine data lines required for puzzle grid\n" if $. > 9;
    chomp;
    die "Line $.: data -->$_<-- invalid\n" unless /^[1-9.]{9}$/;

    # Set row number from input data line number, split line into
    # individual characters then iterate over the characters.
    #
    my $row = $. - 1;
    my @chars = split //;
    foreach my $col (0 .. 8)
    {

        # If character is a dot, create an empty list in the hash
        # of empty cells. Otherwise, put the number found into the
        # correct cell of the puzzle grid and set same cell in the
        # grid of numbers set at initialisation.
        #
        if($chars[$col] eq '.')
        {
            my $rlGroupKeys = getKeys($row, $col);
            my $cellKey = "r${row}c${col}";
            $rhEmptyCells->{$cellKey} = [];
            push @{$rhAffected->{$_}}, $cellKey for @$rlGroupKeys
        }
        else
        {
            $rlGrid->[$row]->[$col] = $chars[$col];
            $rlInitialNos->[$row]->[$col] ++;
        }
    }
}

# Close input file. Validate puzzle grid and abort if it is a duffer.
#
close IN or die "close: $inputFile: $!\n";
if(my $gridError = validateGrid($rlGrid))
{
    print "\nERROR: $gridError\n\n";
    printGrid($rlGrid);
    die "ABORTING\n";
}

# Show puzzle grid as initialised.
#
print "\nPuzzle grid to solve\n";
printGrid($rlGrid);

# Set up an anonymous hash to contain entries keyed by row, column
# or block identifier (r0 thru r8, c0 thru c8 and b00 thru b66, the
# two block digits signifying the row and column of the top-left cell
# of a 3x3 block). The value for each group of nine is an anonymous
# list of numbers that could occupy any empty cell in the group.
# Do rows and columns first, calling groupPossibles() for each.
#
our $rhGroupsOf9 = {};
foreach my $rowOrCol (0 .. 8)
{
    my $rowKey = "r$rowOrCol";
    my $colKey = "c$rowOrCol";
    $rhGroupsOf9->{$rowKey} = groupPossibles($rlGrid, $rowKey);
    $rhGroupsOf9->{$colKey} = groupPossibles($rlGrid, $colKey);
}

# Now do the 3x3 blocks.
#
foreach my $blockRow (0, 3, 6)
{
    foreach my $blockCol (0, 3, 6)
    {
        my $blockKey = "b$blockRow$blockCol";
        $rhGroupsOf9->{$blockKey} = groupPossibles($rlGrid, $blockKey);
    }
}

# Now that we know which numbers are possibilities for each group of
# nine we can now populate the lists of possible numbers for each empty
# cell.
#
foreach my $cell (keys %$rhEmptyCells)
{
    my $row = substr $cell, 1, 1;
    my $col = substr $cell, 3, 1;
    my $rlGroupKeys = getKeys($row, $col);
    my %count = ();
    foreach my $group (@$rlGroupKeys)
    {
        $count{$_} ++ for @{$rhGroupsOf9->{$group}};
    }
    foreach my $digit (keys %count)
    {
        delete $count{$digit} unless $count{$digit} == 3;
    }
    push @{$rhEmptyCells->{$cell}}, keys %count;
}

# Invoke the findSolutions() subroutine, passing it the puzzle
# grid, the groups of nine, empty cells and cells affected hashes
# and the key of the next cell to fill from the empty cells hash.
# The nextCellKey() routine chooses the cell with the fewest possible
# digits. Any solution found will be printed by the findSolutions()
# routine.
#
findSolutions($rlGrid, $rhGroupsOf9, $rhEmptyCells, $rhAffected,
   nextCellKey($rhEmptyCells));

# Print message if no solution was found. Exit program.
#
print "\nNo solution found\n\n" unless $solnCt;

exit;

#
# -:-:-:- End of main() -:-:-:-
#

#   -------------
sub findSolutions
#   -------------

# Subroutine to populate the grid, a cell at a time, trying
# a possible number then moving on to the next cell by calling
# itself recursively until either a complete solution is
# arrived at or there are no possible values for the cell
# being examined, at which point the routine returns back to
# a previous cell that has other possible numbers to examine.
# If a complete solution is found, i.e. a call to nextCell()
# returns undef because all empty cells have been filled, print
# out the solution grid then return to look for more possible
# solutions.
#

{
    # Get the puzzle grid, the hash of possible numbers for each
    # row, column or block, the hash of empty cells, the hash of
    # cells affected by group and the key of the current empty cell
    # that we are about to fill in. If the current cell key is undef
    # then there were no empty cells left when findSolutions() was
    # called this time so we have a solution. Print it then validate
    # it, die if bad, otherwise return.
    #
    my($rlGrid, $rhGroupsOf9, $rhEmptyCells, $rhAffected,
       $currentCellKey) = @_;
    unless($currentCellKey)
    {
        print "Solution no. ", ++ $solnCt, "\n";
        printGrid($rlGrid);
        if(my $gridError = validateGrid($rlGrid))
        {
            print "\nERROR: $gridError\n\n";
            die "ABORTING\n";
        }
        return;
    }

    # Extract row and column from key. Get keys of the groups of nine
    # affected by the current cell.
    #
    my $row = substr $currentCellKey, 1, 1;
    my $col = substr $currentCellKey, 3, 1;
    my $rlGroupKeys = getKeys($row, $col);

    # Iterate over the possible values for the current cell as held in
    # the $rhEmptyCells hash.
    #
    foreach my $try (@{$rhEmptyCells->{$currentCellKey}})
    {
        # Construct a regular expression used to remove the number
        # from lists.
        #
        my $rxEliminate = qr{[^$try]};

        # Replicate $rlGrid, $rhGroupsOf9, $rhEmptyCells and $rhAffected
        # ready to fill in the current cell with it's possible values
        # and update the data structures.
        #
        my $rlNewGrid = replicateGrid($rlGrid);
        my $rhNewGroupsOf9 = replicateHoL($rhGroupsOf9);
        my $rhNewEmptyCells = replicateHoL($rhEmptyCells);
        my $rhNewAffected = replicateHoL($rhAffected);

        # Place the number we are trying this time in the replica puzzle
        # grid. Remove the current cell from the replica empty cells
        # hash.
        #
        $rlNewGrid->[$row]->[$col] = $try;
        delete $rhNewEmptyCells->{$currentCellKey};

        # Iterate over the groups of nine that are affected by the current
        # cell, modifying the replica anonymous hashes with the number.
        #
        foreach my $group (@$rlGroupKeys)
        {
            # Update this group to remove the number from it's list of
            # possible numbers.
            #
            @{$rhNewGroupsOf9->{$group}} =
               grep /$rxEliminate/, @{$rhNewGroupsOf9->{$group}};

            # Delete the current cell key from the list of affected cells
            # for this group of nine.
            #
            @{$rhNewAffected->{$group}} =
               grep {$_ !~ /$currentCellKey/} @{$rhNewAffected->{$group}};

            # Now update the possible numbers for each remaining empty cell
            # in this group of nine.
            #
            foreach my $cellKey (@{$rhNewAffected->{$group}})
            {
                @{$rhNewEmptyCells->{$cellKey}} =
                   grep /$rxEliminate/, @{$rhNewEmptyCells->{$cellKey}};
            }
        }

        # Now call findSolutions() recursively with the modified data
        # structures and the next cell to examine.
        #
        findSolutions($rlNewGrid, $rhNewGroupsOf9, $rhNewEmptyCells,
           $rhNewAffected, nextCellKey($rhNewEmptyCells));
    }

    # Return now that we have tried all possibilities.
    #
    return;
}

#
# -:-:-:- End of findSolutions() -:-:-:-
#

#   -------
sub getKeys
#   -------

# Subroutine to generate the keys into the $rhGroupsOf9 anonymous
# hash for a given cell row and column and return a list reference.
#
{
    my($row, $col) = @_;
    my $rowKey = "r$row";
    my $colKey = "c$col";
    my $blockKey = "b" . int($row / 3) * 3 . int($col / 3) * 3;
    return [$rowKey, $colKey, $blockKey];
}

#
# -:-:-:- End of getKeys() -:-:-:-
#

#   --------------
sub groupPossibles
#   --------------

# Subroutine to return a reference to a list of possible numbers for
# any empty cells in a given row, column or 3x3 block
#
{
    # Get puzzle grid and group of 9 key. Initialise a list of numbers
    # found for this group. Test whether we are dealing with a row,
    # column or block.
    #
    my($rlGrid, $key) = @_;
    my @found = ();
    if($key =~ /r(\d)/)
    {
        # It's a row, move along the row pushing any numbers found
        # onto the list.
        #
        my $row = $1;
        foreach my $col (0 .. 8)
        {
            next if $rlGrid->[$row]->[$col] eq ' ';
            push @found, $rlGrid->[$row]->[$col];
        }
    }
    elsif($key =~ /c(\d)/)
    {
        # It's a column so move down this time.
        #
        my $col = $1;
        foreach my $row (0 .. 8)
        {
            next if $rlGrid->[$row]->[$col] eq ' ';
            push @found, $rlGrid->[$row]->[$col];
        }
    }
    elsif($key =~ /b(\d)(\d)/)
    {
        # This one's a 3x3 block. Traverse block by columns within
        # rows
        #
        my $row = $1;
        my $col = $2;
        for (
           my $blockRow = $row;
           $blockRow < $row + 3;
           $blockRow ++)
        {
            for (
               my $blockCol = $col;
               $blockCol < $col + 3;
               $blockCol ++)
            {
                next if $rlGrid->[$blockRow]->[$blockCol] eq ' ';
                push @found, $rlGrid->[$blockRow]->[$blockCol];
            }
        }
    }
    else
    {
        # If we get here then the row/column/block argument is duff.
        #
        die "groupPossibles(): key not recognised: $key\n";
    }

    # Set up a hash with all digits from 1 to 9 as keys. Then delete
    # a hash slice of those numbers already found. The remaining keys
    # are the possible numbers so return them as a list reference.
    #
    my %possibles = ();
    $possibles{$_} ++ for (1 .. 9);
    delete @possibles{@found};
    return [keys %possibles];
}

#
# -:-:-:- End of groupPossibles() -:-:-:-
#

#   -----------
sub nextCellKey
#   -----------

# Subroutine to return the key into the empty cells hash of the next
# cell to be examined, or undef if there are no empty cells left. Each
# cell is examined to see how many numbers there are possible for it
# and the results are sorted so that those with the fewest are chosen
# next.
#

{
    # Get anonymous hash of empty cells, return undef if there are
    # no empty cells left,
    #
    my $rhEmptyCells = shift;
    return undef unless my @keys = keys %$rhEmptyCells;

    # Sort the empty cell into ascending count of possible numbers so
    # that cells with fewest possibilities are first, returning the
    # first element of the sorted list of keys.
    #
    return
    (
       map {$_->[0]}
       sort {$a->[1] <=> $b->[1]}
       map {[$_, scalar @{$rhEmptyCells->{$_}}]}
       @keys
    )[0];
}

#
# -:-:-:- End of nextCell() -:-:-:-
#

#   ---------
sub printGrid
#   ---------

# Subroutine to print the supplied grid to STDOUT with formatting to
# improve readability.
#

{
    # Get grid to print.
    #
    my $rlGrid = shift;

    # Print top two lines of the grid that form just the top border and
    # the first of the column separators. Initialise row count.
    #
    print "\n", $boldRowSep, $colSep;
    my $rowNo = 0;

    # Iterate over the rows in the puzzle grid calling the printRow
    # routine to output the line with numbers in.
    #
    foreach my $rlRow (@$rlGrid)
    {
        printRow($rlRow, $rowNo);

        # Increment row number. Print a column separator then a light
        # or bold row separator depending whether we have just done a
        # block of three rows. Print another column separator ready
        # the next row of data unless we are at the end of the grid.
        #
        $rowNo ++;
        print $colSep, $rowNo % 3 ? $lightRowSep : $boldRowSep;
        print $colSep unless $rowNo == 9;
    }

    # Print a newline after the grid then return.
    #
    print "\n";
    return;
}

#
# -:-:-:- End of printGrid() -:-:-:-
#

#   --------
sub printRow
#   --------

# Subroutine to print the grid rows that contain the actual numbers of
# the puzzle. If the number to be printed in a particular cell is one
# that was set at the beginning, it is printed in bold to stand out.
#

{
    # Get a reference to the row to be printed and it's number so that
    # the $rlInitialNos list of lists can be queried. Print the left
    # edge of the grid. Initialise column number.
    #
    my($rlRow, $rowNo) = @_;
    print " " . BOLD . "|" . RESET;
    my $colNo = 0;

    # Iterate along the row printing each number, bold or otherwise, in
    # the correct column with the relevant separator between.
    #
    foreach my $col (@$rlRow)
    {
        print "  ";
        print $rlInitialNos->[$rowNo]->[$colNo] ?
           BOLD . $col . RESET :
           $col;
        $colNo ++;
        print $colNo % 3 ?
           "  |" :
           "  " . BOLD . "|" . RESET;
    }

    # Print newline to end the row and return.
    #
    print "\n";
    return;
}

#
# -:-:-:- End of printRow() -:-:-:-
#

#   ------------
sub replicateHoL
#   ------------

# Subroutine to replicate a hash of lists structure as found in the
# $rhGroupsOf9 and $rhEmptyCells anonymous hashes and return a reference
# to a new hash of lists containing the same data.
#
{
    # Get original grid, initialise the copy.
    #
    my $rhOriginal = shift;
    my $rhReplica = {};

    # Iterate over the keys of the original, setting the values of
    # the replica to anonymous lists containing the de-referenced
    # contents of the original's lists.
    #
    foreach my $key (keys %$rhOriginal)
    {
        $rhReplica->{$key} = [@{$rhOriginal->{$key}}];
    }

    # Return the replica hash of lists.
    #
    return $rhReplica;
}

#
# -:-:-:- End of replicateHoL() -:-:-:-
#

#   -------------
sub replicateGrid
#   -------------

# Subroutine to replicate the supplied grid and return a reference to a
# new list of lists containing the same data.
#
{
    # Get original grid, initialise the copy.
    #
    my $rlOriginal = shift;
    my $rlReplica = [];

    # Iterate over the rows in the original pushing a reference to a new
    # list onto the replica list of lists containing the dereferenced
    # contents of the original row.
    #
    foreach my $row (@$rlOriginal)
    {
        push @$rlReplica, [@$row];
    }

    # Return the completed grid replica.
    #
    return $rlReplica;
}

#
# -:-:-:- End of replicateGrid() -:-:-:-
#

#   ------------
sub validateGrid
#   ------------

# Subroutine to validate the puzzle grid just read from data file.
#

{
    # Get grid to validate. Initialise hash that will be used to
    # hold the numbers found in each row, column or block so that
    # duplicate numbers can be spotted.
    #
    my $rlGrid = shift;
    my($row, $col, %numbersSeen);

    # First, examine grid row by row for duplicates.
    #
    for $row (0 .. 8)
    {
        # Reset numbers seen hash for each row; move along, column
        # by column, incrementing hash entry for numbers seen. Ignore
        # blank cells.
        #
        %numbersSeen = ();
        for $col (0 .. 8)
        {
            next if $rlGrid->[$row]->[$col] eq " ";
            $numbersSeen{$rlGrid->[$row]->[$col]} ++;
        }

        # Now check each hash entry for multiple numbers. Return an
        # error string if a multiple is found.
        #
        for (keys %numbersSeen)
        {
            return "Row @{[$row + 1]} has more than one $_" if
               $numbersSeen{$_} > 1;
        }
    }

    # Do the same for columns.
    #
    for $col (0 .. 8)
    {
        # Reset hash for each column this time; move down column, row by
        # row.
        #
        %numbersSeen = ();
        for $row (0 .. 8)
        {
            next if $rlGrid->[$row]->[$col] eq " ";
            $numbersSeen{$rlGrid->[$row]->[$col]} ++;
        }

        # Again, check for multiples, returning an error string if
        # appropriate.
        #
        for (keys %numbersSeen)
        {
            return "Column @{[$col + 1]} has more than one $_" if
               $numbersSeen{$_} > 1;
        }
    }

    # Now examine the 3x3 blocks. Check in the order top-left, top-
    # centre, top-right, middle-left, middle-centre, middle-right,
    # bottom-left, bottom-centre, bottom-right.
    #
    my @blockNames = qw(
       Top-left
       Top-centre
       Top-right
       Middle-left
       Middle-centre
       Middle-right
       Bottom-left
       Bottom-centre
       Bottom-right);

    # Take every third column within every third row as the top-left
    # cell in each of our 3x3 blocks.
    #
    for $row (0, 3, 6)
    {
        for $col (0, 3, 6)
        {
            # Reset hash, get current block name.
            #
            %numbersSeen = ();
            my $blockname = shift @blockNames;

            # For this block, move across the three columns within
            # the three rows recording which numbers we see.
            #
            for (
               my $blockRow = int($row / 3) * 3;
               $blockRow < (int($row / 3) + 1) * 3;
               $blockRow ++)
            {
                for (
                   my $blockCol = int($col / 3) * 3;
                   $blockCol < (int($col / 3) + 1) * 3;
                   $blockCol ++)
                {
                    next if $rlGrid->[$blockRow]->[$blockCol] eq " ";
                    $numbersSeen{$rlGrid->[$blockRow]->[$blockCol]} ++;
                 }
            }

            # Check, and return error string if multiple found. Only
            # detects first error, there may be more.
            #
            for (keys %numbersSeen)
            {
                return "$blockname block has more than one $_" if
                   $numbersSeen{$_} > 1;
            }
        }
    }

    # If all tests have been passed, return 0 (false) so that no error
    # is flagged.
    #
    return 0;
}

#
# -:-:-:- End of validateGrid() -:-:-:-
#