#!/usr/bin/perl -w
#
# Sudoku loeser
#
# autor: (c) patrick diebold 9/2006
# uses some simple ki modules and starts backtracking afterwards
# version 1.0
#

# TODO:
# 
# Solving Sudoku: (www.de.wikipedia.org/sudoku)
# ki_twin
# ki_triplet
# ki_extraneous

# modules
use strict;
use Data::Dumper;

# config
my $DEBUG = 0;
my $SETSUDOKU = 1;

# prototypes
sub init_spicker(\@\@);
sub prepare_spicker();
sub print_sudoku(@);
sub print_spicker(@);

sub set($$$\@\@);
sub check_valid($$$\@);
sub count_sudoku(@);
sub is_only_one($$\@);

sub ki_set_if_only_one_possible(\@\@);
sub ki_set_if_only_one_per_row_left(\@\@);

sub ki_backtrack(@);
sub get_next(\@);         # backtrack helper
sub sudoku_valid($$$\@);  # backtrack helper

# functions 
sub read_sudoku($){
	my $file = shift;
	my @sudoku;
	my $row=0;
	my $col=0;
	open (INFILE, $file) or die ("can not open $file");
	my @lines = <INFILE>;
	close (INFILE);

	foreach my $line (@lines) {
		# accept comments
		next if $line =~ /^[^|]/;
		print $line if $DEBUG;
		$col = 0;
		my @chars = split(//, $line);
		foreach my $char (@chars) {
			if ( $char =~ /[123456789_]/ ) {
				print "[$char]($col)" if $DEBUG;
				$sudoku[$row]->[$col] = $char;
				$col++;	
			}
		}
		$row++;
		print "\n---------------------------\n" if $DEBUG;
	}
	if ($row != 9 || $col != 9) { die "error sudoku fehlerhaft"; }
	return @sudoku;
}

# desc: print current sudoku status
sub print_sudoku(@){
	my @sudoku = @_;

	print "+---+---+---+\n";
	my $j=0;
	for my $line (@sudoku) { 
		print "|";
		for (my $i=0; $i<9; $i++) {
			print "@$line[$i]";
			print "|" if ($i % 3 == 2);
		}
		print "\n";
		print "+---+---+---+\n" if ($j % 3 == 2);
		$j++;
	}
}

# desc: initialize spicker all fields - all numbers
sub prepare_spicker(){
	my @spicker;
	for (my $row = 0; $row < 9; $row++) {
		for (my $col = 0; $col < 9; $col++) {
			$spicker[$row][$col] = [1,2,3,4,5,6,7,8,9];
		}
	} 
	return @spicker;
}

# row, col, val
# return: anzahl der entfernten einträge
sub set($$$\@\@){
	my ($par_row, $par_col, $par_val, $spicker, $sudoku) = @_;

	my $ret = 0;

	if ($par_val eq "_") { return $ret; }

	# alle in der reihe entfernen
	for (my $row=0; $row<9; $row++) {
		if (($spicker->[$row][$par_col][$par_val-1] ne "_") && ($row != $par_row)) {
			$spicker->[$row][$par_col][$par_val-1] = "_";
			$ret++;
		}
	}

	# alle in der spalte entfernen
	for (my $col=0; $col<9; $col++) {
		if (($spicker->[$par_row][$col][$par_val-1] ne "_") && ($col != $par_col)) {
			$spicker->[$par_row][$col][$par_val-1] = "_";
			$ret++;
		} 
	}
	
	# all in einem Kästchen entfernen
	my $row_start = ($par_row - ($par_row % 3));
	my $col_start = ($par_col - ($par_col % 3));
	for (my $row = $row_start; $row < ($row_start + 3); $row++) {
		for (my $col = $col_start; $col < ($col_start + 3); $col++) {
			if ((($row != $par_row) || ($col != $par_col)) && $spicker->[$row][$col][$par_val-1] ne "_") {
				$spicker->[$row][$col][$par_val-1] = "_";
				$ret++;
			}
		}
	}
	
	# selbst setzen
	for (my $i=0; $i<9; $i++) {
		$spicker->[$par_row][$par_col][$i] = "_";
	}
	$spicker->[$par_row][$par_col][$par_val-1] = $par_val;
	if ($SETSUDOKU) { $sudoku->[$par_row][$par_col] = $par_val; }

	if ($ret != 0 && check_valid($par_row,$par_col,$par_val,@{$spicker}) == -1) {
		print ("error setting invalid value: $par_row, $par_col, $par_val\n");
	}
	return $ret;
}

# desc: set values of sudoku removing invalid possibilities
sub init_spicker(\@\@){
	my ($spicker, $sudoku) = @_;
	for (my $row = 0; $row < 9; $row++) {
		for (my $col = 0; $col < 9; $col++) {
			set($row,$col,$sudoku->[$row][$col],@{$spicker},@{$sudoku});
		}
	}
}

# desc: print current status of spicker
sub print_spicker(@){
	my @spicker = @_;
	print "#";
	print "="x92;
	print "#";
	print "\n";
	for (my $row = 0; $row < 9; $row++) {
		print "||";
		for (my $col = 0; $col < 9; $col++) {
			for (my $i = 0; $i < 9; $i ++) {
				print "$spicker[$row][$col][$i]";
			}
			print "|";
			if ($col % 3 == 2) {
				print "|";
			}
		}
		print "\n";
		if ($row % 3 == 2) {
			print "#";
			print "="x30;
			print "#";
			print "="x30;
			print "#";
			print "="x30;
			print "#";
			print "\n";
		}
	}
	print "count_sodoku: ".count_sudoku(@spicker)."\n";
}

# helper: return number that is single or -1
sub is_only_one($$\@){
	my ($par_row, $par_col, $spicker) = @_;
	my $ret = -1;

	for (my $i=0; $i<9; $i++) {
		if ($spicker->[$par_row][$par_col][$i] ne "_") {
			if ($ret == -1) {
				$ret = $i+1;
			} else {
				return -1;
			}
		}
	}
	return $ret;
}

# desc: check all fields; set field if only one number possible left
sub ki_set_if_only_one_possible(\@\@){
	my ($spicker, $sudoku) = @_;
	my $ret = 0;
	my $element;
	for (my $row = 0; $row < 9; $row++) {
		for (my $col = 0; $col < 9; $col++) {
			$element = is_only_one($row,$col,@{$spicker});
			if ($element != -1) {
				$ret = set($row,$col,$element,@{$spicker},@{$sudoku});
				if ($ret != 0) {
					return $ret;
				}
			}
		}
		#print_sudoku(@sudoku);
	}
	return $ret;
}

# return: 0 ok -1 nicht ok
# recursion
sub ki_backtrack(@){
	my @sudoku = @_;

	my $x;	
	my $y;
	($x,$y) = get_next(@sudoku);
	if ($x==9 && $y==9) { 
		return 0;
	 }
	for (my $val=1; $val<=9; $val++) {
		print "[$x][$y]: $val - " if $DEBUG;
		if (sudoku_valid($x,$y,$val,@sudoku) == 1) {
			print "valid:\n" if $DEBUG;
			print_sudoku(@sudoku) if $DEBUG;
			$sudoku[$x][$y] = $val;
			if (ki_backtrack(@sudoku) == 0) {
				return 0;
			} else {
				$sudoku[$x][$y] = '_';
			}
		} else {
			print "invalid\n" if $DEBUG;
		}
	}
	return -1;
}

#row,col,val,@sudoku
sub sudoku_valid($$$\@){
	my ($row, $col, $val, $sudoku) = @_;

	#1) im Feld erlaubt
	return -1 if ($sudoku->[$row][$col] ne "_");

	#2) in Reihe
	for (my $x = 0; $x < 9; $x++) {
		next if $x == $row;
		return -1 if ($sudoku->[$x][$col] eq "$val");
	}

	#3) in Spalte
	for (my $x = 0; $x < 9; $x++) {
		next if $x == $col;
		return -1 if ($sudoku->[$row][$x] eq "$val");
	}

	#4) im Quadrat
	my $row_begin = ($row - ($row % 3));
	my $row_end   = $row_begin + 3;
	my $col_begin = ($col - ($col % 3));
	my $col_end   = $col_begin + 3;
	for (my $x = $row_begin; $x < $row_end; $x++){
		for (my $y = $col_begin; $y < $col_end; $y++) {
			next if (($x == $row) && ($y == $col));;
			return -1 if ($sudoku->[$x][$y] eq "$val");
		}
	}
	# alles ok
	return 1;
}

# TODO: check uninitialized value
sub check_valid($$$\@){
	my ($row, $col, $val, $spicker) = @_;

	if ($val eq "_") {
		return 1;
	}
	#1) im Feld erlaubt
	if ($spicker->[$row][$col][$val-1] eq "_") {
		return -1;
	}
	#2) in Reihe
	for (my $i=0; $i<9; $i++) {
		next if $i == $row;
		if ($spicker->[$i][$col][$val-1] ne "_" ) {
			if (is_only_one($i,$col,@{$spicker})){
			# schon gesetzt
				return -1;
			}
		}
	}
	#3) in Spalte
	for (my $i=0; $i<9; $i++) {
		next if $i == $col;
		if ($spicker->[$row][$i][$val-1] ne "_" ) {
			if (is_only_one($row,$i,@{$spicker})){
			# schon gesetzt
				return -1;
			}
		}
	}
	#4) im Quadrat
	my $row_begin = ($row - ($row % 3));
	my $row_end   = $row_begin + 3;
	my $col_begin = ($col - ($col % 3));
	my $col_end   = $col_begin + 3;
	for (my $x = $row_begin; $x < $row_end; $x++){
		for (my $y = $col_begin; $y < $col_end; $y++) {
			next if (($x == $row) && ($y == $col));;
			if ($spicker->[$x][$y][$val-1] ne "_"){
				if (is_only_one($x,$y,@{$spicker})){
					return -1;
				}
			}
		}
	}
	# alles ok
	return 1;
}

# desc: check rows, whether one number is only valid in one field
sub ki_set_if_only_one_per_row_left(\@\@){
	my ($spicker, $sudoku) = @_;
	my $ret = 0;
	my $tmp_row = 0;
	my $tmp_col = 0;

	for (my $i=0; $i < 9; $i++) {
		# reihenweise
		for (my $row = 0; $row < 9; $row++) {
			my $count = 0;
			for (my $col = 0; $col < 9; $col++) {
				if ($spicker->[$row][$col][$i] ne "_") {
					$count++;
					$tmp_row=$row;
					$tmp_col=$col;
				}
			}
			if ($count == 1) {
				my $tmp_ret;
				if (($tmp_ret = set($tmp_row,$tmp_col,$i+1,@{$spicker},@{$sudoku})) != 0) {
					$ret++;
				}
			}
		}
		# spaltenweise
		for (my $col = 0; $col < 9; $col++) {
			my $count = 0;
			for (my $row = 0; $row < 9; $row++) {
				if ($spicker->[$row][$col][$i] ne "_") {
					$count++;
					$tmp_row=$row;
					$tmp_col=$col;
				}
			}
			if ($count == 1) {
				my $tmp_ret;
				if (($tmp_ret = set($tmp_row,$tmp_col,$i+1,@{$spicker},@{$sudoku})) != 0) {
					$ret++;
				}
			}
		}
		# TODO: blockweise
	}
	return $ret;
}

# count number of possible entries => 81 means sudoku solved
sub count_sudoku(@){
	my @spicker = @_;
	my $ret = 0;
	for (my $i=0; $i < 9; $i++) {
		for (my $row = 0; $row < 9; $row++) {
			for (my $col = 0; $col < 9; $col++) {
				if ($spicker[$row][$col][$i] ne "_") {
					$ret ++;
				}
			}
		}
	}
	return $ret;
}

# return next empty field
sub get_next(\@){
	my ($sudoku) = @_;
	for (my $x=0; $x<9; $x++){
		for(my $y=0; $y<9; $y++){
			if ($sudoku->[$x][$y] eq '_') {
				return ($x,$y);
			}
		}
	}
	return (9,9);
}

# desc: detect if two values can be only on exactly two fields
sub ki_twin(\@\@){
	my ($spicker,$sudoku) = @_;
	my $ret = 0;
	# row
	# col
	# block
	return $ret;
}

# desc: detect if values have to be set in one of 3 fields in a row (delete from other fields in the line)
sub ki_triplet(\@\@){
	my ($spicker,$sudoku) = @_;
	return 0;
}

# call ki and print msg + metainfo
sub call_ki(\&$\@\@){
	my ($ki) = shift;
	my $msg  = shift;
	my ($spicker,$sudoku) = @_;
	my $ret = 0;

	print "calling ki: $msg ";
	while (&$ki != 0) {
		print ".";
		$ret++;
	}
	print " -- finished -- ki run ".$ret." times - sudoku count: ".count_sudoku(@{$spicker})."\n";
	return $ret;
}

sub main(){
	my $ret;
	my @sudoku;
	my @spicker;

	my $start;
	my $start_bt;
	my $end;

	# TODO: pass as parameter
	my $file = "Sudoku.txt";
	
	@sudoku = read_sudoku($file);
	print_sudoku(@sudoku);
	@spicker = prepare_spicker();
	init_spicker(@spicker, @sudoku);
	print_spicker(@spicker) if $DEBUG;

	$start = time();

	# run ki's
	do {	
		$ret  = call_ki(&ki_set_if_only_one_per_row_left, "one per row", @spicker,@sudoku);
		$ret += call_ki(&ki_set_if_only_one_possible, "one per field", @spicker,@sudoku);
		$ret += call_ki(&ki_twin,"detect twins",@spicker,@sudoku);
		$ret += call_ki(&ki_triplet,"use triplets",@spicker,@sudoku);
		print_spicker(@spicker) if $DEBUG;
	} while ($ret != 0);

	if (count_sudoku(@spicker) == 81) {
		print "sudoku solved !!!\n";
	} else {
		print "Run backtracking - before:\n";
		print_sudoku(@sudoku);
		$start_bt = time();
		if (ki_backtrack(@sudoku) == 0) {
			print "solved: \n";
			print_sudoku(@sudoku);
		}
	}

	$end = time();
	print "Times used:\n";
	print " other : ".($start_bt-$start)."\n";
	print " btrack: ".($end-$start_bt)."\n";
	print " total : ".($end-$start)."\n";
}

main();