#!/usr/local/bin/perl -w

use strict;
use Data::Dumper;

$::MULTIPLE_VALUES = 1;
$::CORRECT = 2;
$::INCORRECT = 4;

$::DEBUG = 0;

# $::neighbor_map[81];
# $::puzzle

#  0  1  2  3  4  5  6  7  8 
#  9 10 11 12 13 14 15 16 17
# 18 19 20 21 22 23 24 25 26
# 27 28 29 30 31 32 33 34 35
# 36 37 38 39 40 41 42 43 44
# 45 46 47 48 49 50 51 52 53
# 54 55 56 57 58 59 60 61 62
# 63 64 65 66 67 68 69 70 71
# 72 73 74 75 76 77 78 79 80

sub construct_neighbor_map {
    my ($i, $j, $k, $l, $m, $n);
    for $i (0..8) {
	for $j (0..8) {
	    for $k (0..8) {
		if($j ne $k) {
		    $::neighbor_map->[9*$i+$j]->{9*$i+$k} = 1;
		}
		if(9*$i ne 9*$k) {
		    $::neighbor_map->[9*$i+$j]->{9*$k+$j} = 1;
		}
	    }
	}
    }

    for $i (0,3,6) {
	for $j (0, 27, 54) {

	    for $k (0..2) {
		for $l (0,9,18) {

		    for $m (0..2) {
			for $n (0,9,18) {

			    if($k + $l ne $m + $n) {
				$::neighbor_map->[$i+$j+$k+$l]
				    ->{$i+$j+$m+$n} = 1
				}
			}
		    }
		}
	    }
	}
    }
}

sub read_puzzle {
    my @vals;
    my @data;
    while(<>) {
	s/^\s*//go;
	s/\s*$//go;
	s/\s+/ /go;
	@vals = split(" ", $_);
	for(@vals) {
	    if(!/^[0-9]$/) {
		die "Invalid value: $_\n";
	    }
	}
	push (@data, @vals);
	last if @data >= 81;
    }
    
    my @ret;
    my $cnt;
    my $i;
    for $cnt (0..80) {
	if($data[$cnt] == 0) {
	    for $i (1..9) {
		$ret[$cnt]->{$i} = 1;
	    }
	} else {
	    $ret[$cnt]->{$data[$cnt]} = 1;
	}
    }
    return @ret;
}

sub reduce {
    my $keep_reducing = 1;
    my @puzzle = @_;

    my $cnt;
    my (@keya, $key, $neighbor, $index);
    while($keep_reducing) {
	$keep_reducing = 0;
	for $index (0..(@puzzle-1)) {
	    if ((keys %{$puzzle[$index]}) == 1) {
		@keya = keys %{$puzzle[$index]};
		$key = $keya[0];
		for $neighbor (keys %{$::neighbor_map->[$index]}) {
		    if(defined $puzzle[$neighbor]{$key}) {
			delete $puzzle[$neighbor]{$key};
			$keep_reducing = 1;
		    }
		}
	    }
	}
    }
    return @puzzle;
}

sub print_puzzle {
    my @puzzle = @_;
    my ($index, @keya);

    for $index (0..(@puzzle-1)) {
	if ((keys %{$puzzle[$index]}) == 1) {
	    @keya = keys %{$puzzle[$index]};
	    print $keya[0], " ";
	} elsif ((keys %{$puzzle[$index]}) == 0) {
	    print "! ";
	} else {
	    print "* ";
	}
	if(($index + 1) % 9 == 0) {
	    print "\n";
	}
    }
}

sub check {
    my @puzzle = @_;
    my ($index, @keya);

    my $result = $::CORRECT;
    for $index (0..(@puzzle-1)) {
	if ((keys %{$puzzle[$index]}) > 1) {
	    $result = $::MULTIPLE_VALUES;
	} elsif ((keys %{$puzzle[$index]}) == 0) {
	    return $::INCORRECT;
	} 
    }
    return $result;
}

sub duplicate {
    my @puzzle = @_;
    my @puzzle_ret;
    my ($index);
    for $index (0..(@puzzle-1)) {
	for (keys %{$puzzle[$index]}) {
	    $puzzle_ret[$index]{$_} = 1;
	}
    }
    return @puzzle_ret;
}

sub guess {
    my @puzzle = @_;

    # DEBUG
    print "BEFORE REDUCE:\n" if $::DEBUG;
    &print_puzzle(@puzzle) if $::DEBUG;
    print "----\n" if $::DEBUG;

    # Attempt to solve the puzzle via elimination
    @puzzle = &reduce(@puzzle);

    # DEBUG
    print "AFTER REDUCE:\n" if $::DEBUG;
    &print_puzzle(@puzzle) if $::DEBUG;
    print "----\n" if $::DEBUG;
    
    # If we don't have multiple values, return
    # Immediately
    my $result = &check(@puzzle);
    if($result != $::MULTIPLE_VALUES) {
	return $result, @puzzle;
    }
    
    # There are more than one possible values
    # Duplicate the puzzle
    my @puzzle_guess = &duplicate(@puzzle);

    # Find an item that still has mutliple values
    my ($index, @guess, %guess_h);
    for $index (0..(@puzzle_guess-1)) {

	# Without a sort, our guesses are in
	# somewhat of a random order
	@guess = keys %{$puzzle_guess[$index]};

	# if we already know the correct value,
	# don't make guesses. However, we want to keep
	# testing if have made a guess at all
	if(@guess > 1) {

	    # We break out of this loop through
	    # the use of return statements
	    while (1) {
		print "Testing $guess[0] at $index\n" if $::DEBUG;
		
		# Make a new hash with only one guess
		%guess_h = ($guess[0] => 1);

		# Place it in the puzzle
		$puzzle_guess[$index] = \%guess_h;

		# Recurse with the guess
		($result, @puzzle_guess) = &guess(@puzzle_guess);
		
		if($result == $::CORRECT) {
		    return ($result, @puzzle_guess);
		}

		# We should never get this result value from
		# &guess. While &check can return MULTIPLE_VALUES
		# &guess can only reutrn CORRECT AND INCORRECT
		if($result == $::MULTIPLE_VALUES) {
		    die "Logical error is guess routine.";
		}
		
		# &guess returned with INCORRECT
		# reset @puzzle without the
		# value we just tested
		print "Deleting $guess[0] at $index\n" if $::DEBUG;
		delete $puzzle[$index]{$guess[0]};
		@guess = keys %{$puzzle[$index]};
		if(!@guess) {
		    # We have tested everything in the index.
		    # The previous guess is not correct or
		    # the puzzle is insolvable.
		    print "No valid values at $index\n" if $::DEBUG;
		    return $::INCORRECT, @puzzle;
		}
		
		print "Remaining values at $index: @guess\n" if $::DEBUG;
		@puzzle_guess = &duplicate(@puzzle);
	    }
	}
    }
    
    # We really shouldn't reach this point.
    # With recursion, every case should be covered above.
    return $::INCORRECT, @puzzle;
}

# Create a global neighbor map.
&construct_neighbor_map;

# Read in the puzzle from STDIN
my @puzzle = &read_puzzle;
my $result;

# Find solution
($result, @puzzle) = &guess(@puzzle);

if($result == $::INCORRECT) {
    print "Puzzle cannot be solved\n";
}

# Dump the puzzle
&print_puzzle(@puzzle);