#!/usr/bin/perl

# PUBLIC DOMAIN
# NO WARRANTY

# Author: Richard Rodger, richard@ricebridge.com

# Note: this is not "production" quality code, or even "beta" quality code.
# It's a little experiment and pretty hacky. Use at your own risk.

# usage: perl sudoku.pl squaresize filename
# where squaresize is 2, 3 or 4 and filename contains the initial cells with the given numbers

# The input file should be in the following format:
#
# 6, , ,9,  , , ,0,   ,5,e,c,  , , ,7,x
# a, ,3,2,  ,f,5,c,  0,9,4, , 6,1, ,8,x
# 0, , , , e, , , ,  6, , ,a, c, , ,d,x
#  ,4,5,f, d,b, , ,  2, , , , e, , , ,x
#
#  , , , , f,7, , ,   , ,6, , 3,5, , ,x
#  ,c, , ,  ,0,b,9,  3, , ,2, d,a, ,6,x
#  ,5,7,8, 6, , , ,  e,a, , ,  , , , ,x
#  , , ,0,  ,c,2,e,  9,8, , ,  , , , ,x
#
#  , ,c, , b, ,7, ,   , , , , 8, , ,9,x
#  , , , ,  , , , ,  c, ,0,1, 7,2,3,a,x
#  , ,2,e, c, , ,a,  f,b,3, ,  ,d, , ,x
#  ,3, , , 2,d, ,f,   , , , , b,4,6, ,x
#
# 8,d,6,b, a,1,f,3,   ,7,2,e,  , ,9,4,x
# f,2,e, , 4, , , ,   , ,d, ,  ,6,1,3,x
#  , , , ,  ,e, , ,  1, , ,9,  , ,2, ,x
# 1, , , ,  , , , ,   , , , ,  ,7, , ,x
#
# Whitespace is not significant, but those x markers at the end of the line are required.
# The example is for 4x4 sudoku, reduce appropriately for 3x3.
#


use strict;
use POSIX;

my $sqsize = $ARGV[0];

my @cell = loadcells( $ARGV[1] );
printcells(\@cell);
solve(\@cell);
printcells(\@cell);
verify(\@cell);


sub verify {
    my @cell = @{shift()};

    for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
        my %check;
        for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
            my $val = (keys(%{$cell[$r][$c]}))[0];
            if( "" ne $check{ $val } ) {
                print "BAD:$val at $r,$c\n";
            }
            else {
                $check{$val} = $val;
            }
        }
    }


    for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
        my %check;
        for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
            my $val = (keys(%{$cell[$r][$c]}))[0];
            if( "" ne $check{ $val } ) {
                print "BAD:$val at $r,$c\n";
            }
            else {
                $check{$val} = $val;
            }
        }
    }

    for( my $sr = 0; $sr < $sqsize; $sr++ ) {
        for( my $sc = 0; $sc < $sqsize; $sc++ ) {
            my %check;
            for( my $r = $sqsize*$sr; $r < $sqsize*($sr+1); $r++ ) {
                for( my $c = $sqsize*$sc; $c < $sqsize*($sc+1); $c++ ) {
                    my $val = (keys(%{$cell[$r][$c]}))[0];
                    if( "" ne $check{ $val } ) {
                        print "BAD:$val at $r,$c\n";
                    }
                    else {
                        $check{$val} = $val;
                    }
                }
            }
        }
    }
}


sub solve {
    my @cell = @{shift()};

    my $pass = 0;
    my $changes = 1;
    while( $changes ) {
        $pass++;
        $changes = 0;
        my $rowI = 0;
        for my $row ( @cell ) {
            my $colI = 0;
            for my $col (@{$row}) {
                my $origsize = keys(%{$col});
                if( 1 < $origsize ) {
                    excludeHome(\@cell,$rowI,$colI);
                    excludeVertical(\@cell,$rowI,$colI);
                    excludeHorizontal(\@cell,$rowI,$colI);
                    reduceHome(\@cell,$rowI,$colI);
                    reduceVertical(\@cell,$rowI,$colI);
                    reduceHorizontal(\@cell,$rowI,$colI);

                    if( 2 == keys(%{$col}) ) {
                        excludePair(\@cell,$rowI,$colI);
                    }
                }
                my $size = keys(%{$col});
                $changes = $changes || ($origsize > $size);
                $colI++;
            }
            $rowI++;
        }
    }
    print "passes:$pass\n";
}

# if there are two pairs in a row or col,
# all other cells containing the same values
# cannot have these values, otherwise they
# would contradict one of the pairs, so delete them
sub excludePair {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
        return;
    }

    my $cmpstr = join('',sort(keys(%{$valbin})));

    my @vals = keys(%{$valbin});
    my $valsmatch = 0;


    for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
        if( $c != $pcol ) {    
            my $testbin = $cell[$prow][$c];
            if( 2 == keys(%{$testbin}) ) {
                my $teststr = join('',sort(keys(%{$testbin})));
                if( $cmpstr eq $teststr ) {
                    $valsmatch = 1;
                }
            }
        }
    }

    if( $valsmatch ) {
        for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
            if( $c != $pcol ) {    
                my $testbin = $cell[$prow][$c];
                if( 2 <= keys(%{$testbin}) ) {
                    my $teststr = join('',sort(keys(%{$testbin})));
                    if( $cmpstr ne $teststr ) {
                        for (@vals) {
                            delete(${$testbin}{$_});
                        }
                    }
                }
            }
        }
    }


    $valsmatch = 0;

    for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
        if( $r != $prow ) {    
            my $testbin = $cell[$r][$pcol];
            if( 2 == keys(%{$testbin}) ) {
                my $teststr = join('',sort(keys(%{$testbin})));
                if( $cmpstr eq $teststr ) {
                    $valsmatch = 1;
                }
            }
        }
    }

    if( $valsmatch ) {
        for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
            if( $r != $prow ) {    
                my $testbin = $cell[$r][$pcol];
                if( 2 <= keys(%{$testbin}) ) {
                    my $teststr = join('',sort(keys(%{$testbin})));
                    if( $cmpstr ne $teststr ) {
                        for (@vals) {
                            delete(${$testbin}{$_});
                        }
                    }
                }
            }
        }
    }
}


sub reduceHome {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
        return;
    }

    my $foundval;
    for my $val (keys(%{$valbin})) {

        my $found = 0;
        for( my $r = $sqsize*floor($prow / $sqsize); 
             $r < $sqsize*floor(($prow+$sqsize) / $sqsize); $r++ ) {

            for( my $c = $sqsize*floor($pcol / $sqsize); 
                 $c < $sqsize*floor(($pcol+$sqsize) / $sqsize); $c++ ) {

                if( $prow != $r || $pcol != $c ) {
                    my $testbin = $cell[$r][$c];

                    if( "" ne ${$testbin}{$val} ) {
                        $found = 1;
                    }
                }
            }
        }
        if( !$found ) {
            $foundval = $val;
            last;
        }
    }

    if( "" ne $foundval ) {
        for my $val (keys(%{$valbin})) {
            if( $val ne $foundval ) { 
                delete(${$valbin}{ $val });
            }
        }
    }
}


sub reduceVertical {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
        return;
    }

    my $foundval;
    for my $val (keys(%{$valbin})) {

        my $found = 0;
        for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
            if( $c != $pcol ) {
                my $testbin = $cell[$prow][$c];
                if( "" ne ${$testbin}{$val} ) {
                    $found = 1;
                }
            }
        }
        if( !$found ) {
            $foundval = $val;
            last;
        }
    }

    if( "" ne $foundval ) {
        for my $val (keys(%{$valbin})) {
            if( $val ne $foundval ) { 
                delete(${$valbin}{ $val });
            }
        }
    }
}


sub reduceHorizontal {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
	return;
    }

    my $foundval;
    for my $val (keys(%{$valbin})) {

	my $found = 0;
	for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
	    if( $r != $prow ) {
		my $testbin = $cell[$r][$pcol];
		if( "" ne ${$testbin}{$val} ) {
		    $found = 1;
		}
	    }
	}
	if( !$found ) {
	    $foundval = $val;
	    last;
	}
    }

    if( "" ne $foundval ) {
	for my $val (keys(%{$valbin})) {
	    if( $val ne $foundval ) { 
		delete(${$valbin}{ $val });
	    }
	}
    }

}

sub excludeHome {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
        return;
    }

    for( my $r = $sqsize*floor($prow / $sqsize); 
         $r < $sqsize*floor(($prow+$sqsize) / $sqsize); $r++ ) {

        for( my $c = $sqsize*floor($pcol / $sqsize); 
             $c < $sqsize*floor(($pcol+$sqsize) / $sqsize); $c++ ) {
            if( $prow != $r || $pcol != $c ) {
                my $testbin = $cell[$r][$c];
                if( 1 == keys(%{$testbin}) ) {
                    my $remove = (keys(%{$testbin}))[0];
                    if( 1 < keys(%{$valbin}) ) {
                        delete(${$valbin}{ $remove });
                    }
                }
            }
        }
    }
}



sub excludeVertical {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
      	return;
    }

    for( my $r = 0; $r < ($sqsize*$sqsize); $r++ ) {
        if( $r != $prow ) {
            my $testbin = $cell[$r][$pcol];
            if( 1 == keys(%{$testbin}) ) {
                my $remove = (keys(%{$testbin}))[0];
                if( 1 < keys(%{$valbin}) ) {
                    delete(${$valbin}{ $remove });
                }
            }
        }
    }
}

sub excludeHorizontal {
    my @cell = @{shift()};
    my $prow = shift;
    my $pcol = shift;

    my $valbin = $cell[$prow][$pcol];
    if( 1 == keys(%{$valbin}) ) {
	return;
    }

    for( my $c = 0; $c < ($sqsize*$sqsize); $c++ ) {
	if( $c != $pcol ) {
	    my $testbin = $cell[$prow][$c];
	    if( 1 == keys(%{$testbin}) ) {
		my $remove = (keys(%{$testbin}))[0];
		if( 1 < keys(%{$valbin}) ) {
		    delete(${$valbin}{ $remove });
		}
	    }
	}
    }
}


sub binval {
    my %valbin = shift;
    my $out = "";
    for $_ (keys(%valbin)) {
	$out.=$_;
    }
    return $out;
}

sub printcells {
    my @cell = @{shift()};

    my $rowI = 0;
    for my $row ( @cell ) {
        if( 0 == $rowI % $sqsize ) {
            print "\n";
        }
        my $colI = 0;
        for my $col (@{$row}) {
            foreach my $val (keys( %{$col} )) {
                if( 0 == $colI % $sqsize ) {
                    print " ";
                }
                print $val;
            }
            print "|";
            $colI++;
        } 
        print "\n";
        $rowI++;
    }
    print "\n";
}


sub loadcells {
    my $file = shift;

    my @cell;
    open( F, $file) or die "can't open $file";
    
    my $line;
    my $row = 0;
    while( $line = <F> ) {
        if( $line ne "\n" ) {
            $line =~ s/\n//;
            my @in = split( /,/, " ".$line );
            print join("+",@in)."\n";
            my $in;
            my $col = 0;
            for $in ( @in ) {
                if( "x" ne $in ) {
                    $in =~ s/ //g;
                    my $valbin = {};
                    if( "" ne $in ) { 
                        ${$valbin}{$in}=$in;
                    }
                    else {
                        $valbin = makeValBin();
                    }
                    $cell[$row][$col] = $valbin;
                    $col++;
                }
            }
            $row++;
        } 
    }
    close(F);
    return @cell;
}


sub makeValBin {
    my $valbin;

    if( 2 == $sqsize ) {
	$valbin = {'1', '1',
		   '2', '2',
		   '3', '3',
		   '4', '4', };
    }
    elsif( 3 == $sqsize ) {
	$valbin = {'0','0',
		   '1', '1',
		   '2', '2',
		   '3', '3',
		   '4', '4',
		   '5', '5',
		   '6', '6',
		   '7', '7',
		   '8', '8',
		   '9', '9',
	       };
    }
    elsif( 4 == $sqsize ) {
	$valbin = {'0','0',
		   '1', '1',
		   '2', '2',
		   '3', '3',
		   '4', '4',
		   '5', '5',
		   '6', '6',
		   '7', '7',
		   '8', '8',
		   '9', '9',
		   'a', 'a',
		   'b', 'b',
		   'c', 'c',
		   'd', 'd',
		   'e', 'e',
		   'f', 'f',
	       };
    }

    return $valbin;
}