randomfox

#!perl -w

# Sudoku solver.
#
# Last updated: March 27, 2006
# Author: Po Shan Cheah
#
# This is a puzzle where you have to fill all the blank spaces with digits
# from 1 to 9 such that no row, column, or 3x3 block of cells have any
# digits repeated.
#
# Supply the puzzle via standard input or via a file whose file name is
# given as the first command line argument. Example input:
# 
#   xxx 6xx 9x2
#   xx6 1xx x87
#   2x7 5xx xx1
#   
#   xxx xx8 7xx
#   4x2 xxx 1x6
#   xx9 2xx xxx
#   
#   6xx xx3 5x8
#   59x xx1 2xx
#   8x4 xx7 xxx

use strict;
require 5.004;
use Time::HiRes;

# Parse board information from input.
# Returns a 2D array with numbers from the puzzle and 0s for empty cells.
sub read_board {
    my @board;
    my $lineno = 0;
    while (<>) {
	s/\s+//g;  # Remove whitespace.
	if (length() > 0) {
	    length() < 9 and
		die "Line @{[$lineno+1]} '$_' doesn't have enough cells.\n";

	    # Split line into array of characters.
	    # Convert the first 9 characters into integers.
	    # Store the row into board.
	    $board[$lineno++] =
		[map {/[0-9]/ ? $_+0 : 0} (split(//, $_, 10))[0..8]];
	}
	last if $lineno >= 9;
    }
    $lineno < 9 and
	die "Not enough rows. Only $lineno found.\n";
    return \@board;
}

# Display the board.
sub print_board {
    print join("\n", map {join(" ", @$_)} @{shift()}), "\n";
}

# Return a list of numbers that could go into cell row, col on the board.
sub get_possible {
    my $board = shift;
    my $row = shift;
    my $col = shift;

    my %used = ();

    # Check row and column.
    for my $i (0..8) {
	$used{$board->[$row][$i]} = 1;
	$used{$board->[$i][$col]} = 1;
    }

    # Check the 3x3 block containing this cell.
    my $blockrow = $row - $row % 3;
    my $blockcol = $col - $col % 3;    
    for my $i ($blockrow .. $blockrow + 2) {
	for my $j ($blockcol .. $blockcol + 2) {
	    $used{$board->[$i][$j]} = 1;
	}
    }

    grep(!defined $used{$_}, 1..9);
}

# Keeps track of the number of board possibilities (partial solutions and
# dead ends) examined.
my $nodecount = 0;

# Recursive function to find a solution by exhaustive search.
# Returns 1 if solution found. 0 if no solution found yet.
sub tryboard {
    my $board = shift;
    my $row = shift;
    my $col = shift;

    # If we are already past all the rows and columns then we have a
    # solution.
    if ($row > 8 or $col > 8) {
	print "Found a solution:\n";
	print_board $board;
	return 1;
    }

    ++$nodecount;

    # Calculate the next column, wrapping over to the next row if
    # necessary.
    my $nextrow = $row;
    my $nextcol = $col + 1;
    if ($nextcol > 8) {
	$nextrow = $row + 1;
	$nextcol = 0;
    }

    # Skip over cells that are already filled.    
    $board->[$row][$col] != 0 and
	return tryboard($board, $nextrow, $nextcol);

    # Try all numbers that fit in the current cell.
    for my $tok (get_possible($board, $row, $col)) {
	$board->[$row][$col] = $tok;
	tryboard($board, $nextrow, $nextcol) and return 1;
    }
    $board->[$row][$col] = 0;
    return 0;
}

# Main routine.

my $board = read_board;
print "Puzzle:\n";
print_board $board;

my $t0 = [Time::HiRes::gettimeofday];
tryboard($board, 0, 0) or 
    print "No solution found.\n";
my $elapsed = Time::HiRes::tv_interval $t0;

print "$nodecount nodes examined\n";
print "Elapsed time: $elapsed seconds\n";

__END__