#!/usr/bin/perl
use strict;

#Sudoku::run(Sudoku::testset3());
#Sudoku::run(Sudoku::testset4());
#Sudoku::run(Sudoku::testset5());
#Sudoku::run(Sudoku::testset6());
#Sudoku::run(Sudoku::testset9_1());
#Sudoku::run(Sudoku::testset9());
Sudoku::run(Sudoku::testset9_2());

package Sudoku;
use strict;
use Carp qw(confess);

our $n = 9;
our $min = 1;
our $max = $n;
our @digits = ($min..$max);
our $width = $n;
our $height = $n;
our $undef = 0;
sub init {
	$n = $_[0];
	$min = 1;
	$max = $n;
	@digits = ($min..$max);
	$width = $n;
	$height = $n;
	$undef = 0;
}
BEGIN {init(9);}

sub run {
	my $testset = shift;
	init(sqrt(scalar(@$testset)));

	print "TESTING BOARD:$/";
	print print_board($testset);	
	my $res = sudokutest($testset,0,0,0);
	if (!defined($res)) {
		print "No solution found >:O!!!$/";
		return 0;
	} else {
		print "OMG solution found :O!!!$/";
		print print_board($res);	
		return 1;
	}
}

#assume we can muck with the board
sub sudokutest {
	my ($board,$x,$y,$value) = @_;
	print ".";
	if (def($value)) {
		set($board,$x,$y,$value);
	} else {
		warn "Didn't set value of $undef";
	}
	unless (verify($board)) {
		warn "Not Verified";
		return undef;
	}
	#ok good that one is ok now lets test with other values
	my ($xp,$yp) = ($x,$y);
	while ($xp < $width && $yp < $height && is_set($board,$xp,$yp)) {
		($xp,$yp) = inc($xp,$yp);
	}
	if ($yp >= $height) {
		return $board; #we're done :O~~~~
	}
	my @digits = diff([get_digits()],[get_row($board,$yp)]);
	@digits = diff(\@digits, [get_column($board,$xp)]);
	#if ($n % 3 == 0) {
	@digits = diff(\@digits, [get_block($board,$xp,$yp)]);
	#}
	#warn "Testing at $xp $yp digits qw(@digits)";
	foreach my $digit (@digits) {
		my $res = sudokutest(copy($board),$xp,$yp,$digit);
		if (defined($res)) { return $res; }
	}
	# ;_;  not solution :(
	return undef;
}
sub in_list_num {
	my ($list,$a) = @_;
	foreach (@$list) {
		return 1 if ($a == $_);
	}
	return 0;
}
sub diff {
	my ($a,$b) = @_;
	return grep { !in_list_num($b,$_) } @$a;
}

sub get_digits {
	return @digits;
}
#Increment x and y
sub inc {
	my ($x,$y) = @_;
	$x++;
	if ($x >= $width) {
		$y++;
		$x = 0;
	}
	return ($x,$y);
}
#POSSIBLE OPTIMIZATION: Restrict rechecking rows?
sub verify {
	my ($board) = @_;
	for my $i (0..($max-1)) {
		unless (verify_row($board,$i) && verify_column($board,$i)) {
			return 0;
		}	
	}
	#if ($max % 3 == 0) { #verify blocks
	for my $x (0..($max/3 - 1)) {
		for my $y (0..($max/3 - 1)) {
			verify_block($board,$x*3,$y*3);
		}
	}	
	#}
	return 1;
}
sub verify_block {
	my ($board,$x,$y) = @_;
	my @block = get_block($board,$x,$y);
	return verify_list(@block);
}
sub verify_row {
	my ($board,$y) = @_;
	my @row = get_row($board,$y);
	my $res = verify_list(@row);
	return $res;
}
sub verify_column {
	my ($board,$x) = @_;
	my @row = get_column($board,$x);
	return verify_list(@row);
}
sub get_block {
	my ($board,$x,$y) = @_;
	my $startx = $x - $x%3;
	my $starty = $y - $y%3;
	my @out = ();
	foreach my $dy (0..2) {
		my $ny = $starty + $dy;
		foreach my $dx (0..2) {
			push @out, get($board,$dx+$startx,$ny);
		}
	}
	return @out;
}
sub get_row {
	my ($board,$y) = @_;
	my @out = ();
	my @out = @$board[($y*$width)..(($y+1)*$width-1)];
	return @out;
}
sub get_column {
	my ($board,$x) = @_;
	my @out = ();
	foreach my $y (0..($height-1)) {
		push @out,get($board,$x,$y);
	}
	return @out;
}
sub verify_list {
	my (@list) = @_;
	my @a = get_zeros();
	my $x = 0;
	#warning assumption about digits :O
	for my $res (@list) {
		if (def($res) && $a[$res]) {
			return 0;
		}
		$a[$res]++;
	}
	return 1;
}
sub get_zeros {
	return map { 0 } get_digits();
}
sub def {
	return $_[0] ne $undef;
}
sub is_set {
	return def(get(@_));
}
sub new {
	my @a = map { 0 } (0..($height*$width-1));
	return \@a;
}
sub get {
	my ($a,$x,$y) = @_;
	return $a->[$width*$y + $x];
}
sub set {
	my ($a,$x,$y,$b) = @_;
	if (def($a->[$width*$y + $x])) {
		confess("Something is definaately wrong >:O $x $y, setting a value that is already set?");
	}
	$a->[$width*$y + $x] = $b;
	return $a;
}
sub copy {
	my ($a) = @_;
	my @c = @$a;
	my $c = [@c];
	return $c;
}
sub copy_set {
	my ($a,$x,$y,$b) = @_;
	return set(copy($a),$x,$y,$b);
}
sub print_board {
	my ($board) = @_;
	my ($x,$y) = (0,0);
	my @out = ();
	while ($y < $height) {
		push @out, "\t".get($board,$x,$y);
		if ($x == ($width-1)) {
			push @out, $/;
		}
		($x,$y) = inc($x,$y);
	}
	return join("",@out);
}

sub testset3 {
	return [
		$undef,1,$undef,
		$undef,2,$undef,
		$undef,3,$undef,
	];
}
sub testset4 {
	return [
		$undef,1,$undef,$undef,
		$undef,2,$undef,$undef,
		$undef,3,$undef,$undef,
		$undef,4,$undef,$undef,
	];
}
sub testset5 {
	return [
		$undef,1,$undef,$undef,$undef,
		$undef,2,$undef,$undef,$undef,
		$undef,3,$undef,$undef,$undef,
		$undef,4,$undef,$undef,$undef,
		$undef,5,$undef,$undef,$undef,
	];
}
sub testset6 {
	return [
		$undef,1,$undef,$undef,$undef,$undef,
		$undef,2,$undef,$undef,$undef,$undef,
		$undef,3,$undef,$undef,$undef,$undef,
		$undef,4,$undef,$undef,$undef,$undef,
		$undef,5,$undef,$undef,$undef,$undef,
		$undef,6,$undef,$undef,$undef,$undef,
	];
}

sub testset9 {
	# 9 x 9 
	#$undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, #template
	return [
		5     ,      3, $undef, $undef,      7, $undef, $undef, $undef, $undef,
		6     , $undef, $undef,      1,      9,      5, $undef, $undef, $undef,
		$undef,      9,      8, $undef, $undef, $undef, $undef,      6, $undef,
		     8, $undef, $undef, $undef,      6, $undef, $undef, $undef,      3,
		     4, $undef, $undef,      8, $undef,      3, $undef, $undef,      1,
		     7, $undef, $undef, $undef,      2, $undef, $undef, $undef,      6,
		$undef,      6, $undef, $undef, $undef, $undef,      2,      8, $undef,
		$undef, $undef, $undef,      4,      1,      9, $undef, $undef,      5,
		$undef, $undef, $undef, $undef,      8, $undef, $undef,      7,      9,

	];
}
sub testset9_1 {
	# 9 x 9 
	#$undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, #template
	return [
		$undef, $undef,      6,      7, $undef,      2,      3,      1, $undef, #template
		     8, $undef, $undef, $undef,      9, $undef, $undef,      2,      7, #template
		     7, $undef,      5, $undef, $undef,      8, $undef,      9, $undef, #template
		$undef, $undef,      9,      3,      6, $undef,      8, $undef,      2, #template
		     4,      7, $undef, $undef,      1, $undef, $undef, $undef,      3, #template
		     2,      6, $undef, $undef, $undef,      9, $undef, $undef,      1, #template
		$undef,      9,      7, $undef, $undef, $undef,      1, $undef, $undef, #template
		$undef,      8, $undef,      9, $undef,      1,      4,      3,      5, #template
		     3,      1, $undef, $undef, $undef,      6,      2,      7,      9, #template

	];

}
sub testset9_2 {
	# 9 x 9 
	#$undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, $undef, #template
	return [
		     5, $undef, $undef, $undef,      8, $undef, $undef,      4, $undef, #template
		$undef,      9, $undef, $undef, $undef,      5,      7,      1, $undef, #template
		     4, $undef,      7,      1, $undef, $undef, $undef, $undef, $undef, #template
		$undef, $undef, $undef, $undef,      3, $undef, $undef, $undef,      4, #template
		$undef, $undef, $undef, $undef,      6, $undef, $undef,      7, $undef, #template
		     9, $undef,      8, $undef, $undef, $undef,      3, $undef,      6, #template
		$undef, $undef,      9, $undef, $undef,      8, $undef, $undef, $undef, #template
		$undef,      4, $undef, $undef,      7, $undef,      5, $undef, $undef, #template
		$undef, $undef,      3,      4,      1,      6,      9,      8, $undef, #template

	];

}