Cody Boone Ferguson
8ccdfde9b1
The alt code is in the README.md. It felt like it should be alt code based on what the author stated. Fixed the perl test suite. The script hardcoded the name of the binary but this was not 'aidan' as the author submitted it as 'sudoku-sf'. This broke the script (though I did not test it before, only after). Added to the list of files noted by the author those which were in the tarball and changed the names of any incorrectly named files to be correct. The author stated that in the US sudoku is known not as sudoku but rather Number Place. This however is not true so I removed it as it most likely isn't confusing but still not right (I didn't believe the name, hadn't seen it and did a search and found nothing of the sort). Since the author is from the UK and since they used British English spelling I changed 'period' to 'full stop' as it should be (the author put a '.' in parentheses so it's not confusing to anyone who doesn't know the term anyway). Format fix README.md. Typo fixes. Update .gitignore due to alt code.
367 lines
12 KiB
Perl
Executable File
367 lines
12 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#use strict;
|
|
use warnings;
|
|
use IPC::Open2;
|
|
|
|
my $sf_exe = "./aidan"; # location of sudoku-sf executable
|
|
|
|
my $vflg=0; my $gcmd=$sf_exe; my $scmd=$sf_exe;
|
|
my $gcnt=400; my $soff=2; my $fbad=1; my $ffile=1;
|
|
my $fgen=1; my $zoom=0; my $rflg=1; my $fint=1;
|
|
|
|
my $n; my $stkc; my $stkw;
|
|
|
|
my $squstr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" . "abcdefghijklmnopqrstuvwxyz"
|
|
. "0123456789,.";
|
|
|
|
|
|
sub sq($);
|
|
sub read_file($);
|
|
|
|
sub sq_tst($) {
|
|
my $i;
|
|
$i = substr($_[0],1) if($_[0]=~/^-./);
|
|
$i = read_file($_[0]) unless($i);
|
|
$i = squish($i); print $i,"\n";
|
|
}
|
|
|
|
for($n=0;$n<@ARGV;$n++) {
|
|
if($ARGV[$n] eq "-h"||$ARGV[$n] eq "--help") {
|
|
print "\n",
|
|
"test-su.perl - automated testing for the sudoku-sf sudoku solver\n",
|
|
"Assumes sudoku-sf executable is at \"$sf_exe\" (\$sf_exe)\n",
|
|
"This code is PUBLIC DOMAIN and comes with NO WARRANTY\n\n",
|
|
"Usage:\n",
|
|
"------\n",
|
|
"test-su.perl [-v] [-s solver] [-g <genprog>] [-n <no>] <flags...>\n",
|
|
" -v - verbose mode\n",
|
|
" -s <solver> - path to sudoku solver executable ($sf_exe)\n",
|
|
" -g <genprog> - path to sudoku generator executable ($sf_exe)\n",
|
|
" -n <no> - number of random sudokus to generate and solve (400)\n",
|
|
" -s +Z -Z -z - none of your business (obscure & useless)\n",
|
|
" -h|--help - show this usage screen and exit\n\n",
|
|
"flags (+ enables, - disables):\n",
|
|
" +B|-B - enable/disable testing bad sudoku detection (+B)\n",
|
|
" +F|-F - enable/disable testing sudokus from *.sudoku files (+F)\n",
|
|
" +G|-G - enable/disable sudoku generation (+G)\n",
|
|
" +R|-R - enable/disable PRNG tests (+R, may change)\n",
|
|
" +I|-I - test using included sudoku (+I)\n",
|
|
"Basic usage is just: test-su.perl\n",
|
|
"Add -R if the PRNG tests cause problems, and -n 0 if in a hurry\n";
|
|
exit;
|
|
}
|
|
if($ARGV[$n] eq "-v") { $vflg = 1; next; }
|
|
if($ARGV[$n] eq "-s") { $scmd = $ARGV[++$n]; next; }
|
|
if($ARGV[$n] eq "-g") { $gcmd = $ARGV[++$n]; next; }
|
|
if($ARGV[$n] eq "-n") { $gcnt = 0+$ARGV[++$n]; next; }
|
|
if($ARGV[$n] eq "-S") { $soff = 0+$ARGV[++$n]; next; }
|
|
if($ARGV[$n] eq "-B") { $fbad = 0; next; }
|
|
if($ARGV[$n] eq "+B") { $fbad = 1; next; }
|
|
if($ARGV[$n] eq "-F") { $ffile = 0; next; }
|
|
if($ARGV[$n] eq "+F") { $ffile = 1; next; }
|
|
if($ARGV[$n] eq "-G") { $fgen = 0; $gcnt = 0; next; }
|
|
if($ARGV[$n] eq "+G") { $fgen = 1; next; }
|
|
if($ARGV[$n] eq "+Z") { $zoom = 1; next; }
|
|
if($ARGV[$n] eq "-Z") { $zoom = 0; next; }
|
|
if($ARGV[$n] eq "+R") { $rflg = 1; next; }
|
|
if($ARGV[$n] eq "-R") { $rflg = 0; next; }
|
|
if($ARGV[$n] eq "+I") { $fint = 1; next; }
|
|
if($ARGV[$n] eq "-I") { $fint = 0; next; }
|
|
if($ARGV[$n] eq "-z") { sq_tst($ARGV[++$n]); exit; }
|
|
printf "\nUnknown option '%s', try '-h' for valid options\n\n", $ARGV[$n];
|
|
die("Bad command-line options");
|
|
}
|
|
|
|
|
|
|
|
sub rpe() {
|
|
my $n = ""; my $c=0; local $_;
|
|
foreach(@l) {
|
|
if(/^\s*[\d.]\s*[\d.]\s*[\d.]\s*\|\s*[\d.]\s*[\d.]\s*[\d.]\s*\|\s*[\d.]\s*[\d.]\s*[\d.]\s*$/) {
|
|
s/[^.\d]//g;s/0/./g; $n = $n . $_;
|
|
}
|
|
};
|
|
return $n;
|
|
}
|
|
|
|
sub read_proc($$) {
|
|
my $s; my $pid; my $ret; my $file=""; my $wfile=""; my $e = "";
|
|
$stkc = -1; $stkw = -1;
|
|
if($_[0] eq 'G') {
|
|
print "--------- Generating (#" . $_[1] . ") ---------\n";
|
|
$pid = open2($file, $wfile, $gcmd,$_[1]);
|
|
} elsif($_[0] eq 'S') {
|
|
print "--------------- Solving... ---------------\n";
|
|
$pid = open2($file, $wfile, $scmd);
|
|
print $wfile $_[1];
|
|
} elsif($_[0] eq 'U') {
|
|
print "--------------- Solving... ---------------\n";
|
|
$pid = open2($file, $wfile, $scmd,'U');
|
|
print $wfile $_[1];
|
|
} else {
|
|
die("Internal error: bad input to read_proc()");
|
|
}
|
|
local @l = ( ); my $n = 0;
|
|
while($_=<$file>) {
|
|
push(@l, $_); print "> " . $_ if($vflg);
|
|
$e = $1 if(/^(!!!.*)$/);
|
|
($stkc = $1+0, $stkw = $2+0) if(/\(stk (\d+) (\d+)\)$/);
|
|
}
|
|
# local @l = <$file>;
|
|
close $file; close $wfile;
|
|
waitpid $pid, 0;
|
|
if($?) {
|
|
return $e if($e); return "ret=$?";
|
|
}; $s = rpe(); return $s;
|
|
}
|
|
|
|
sub read_file($) {
|
|
my $s;
|
|
open FILE,"<",$_[0]; local @l = <FILE>; $s = rpe();
|
|
close FILE; return $s;
|
|
}
|
|
|
|
sub squish($) {
|
|
my $n = 0; my $c; my $bc = 0; my $dc = 0; my $s = $_[0];
|
|
my $os = "#";
|
|
while($s ne "") {
|
|
$c = substr $s, 0, 1; $s = substr $s, 1;
|
|
if($c eq "." || $c eq "0") {
|
|
$dc++; if($dc==7||$s eq "") {
|
|
$n |= (($dc==1?0:$dc+8)<<$bc); $bc += 4; $dc = 0;
|
|
}
|
|
} else {
|
|
if($dc) {
|
|
$n |= (($dc==1?0:$dc+8)<<$bc); $bc += 4; $dc = 0;
|
|
}
|
|
$n |= (($c)<<$bc); $bc += 4;
|
|
}
|
|
while($bc >= 6) {
|
|
$os .= substr $squstr, $n & 63, 1;
|
|
$n = $n >> 6; $bc -= 6;
|
|
}
|
|
}
|
|
|
|
$os .= substr $squstr, $n, 1 if($bc);
|
|
return $os;
|
|
}
|
|
|
|
sub unsq($) {
|
|
my $n = 0; my $bc = 0; my $os=""; my $i; my $s = $_[0]; my $j;
|
|
if('#' ne substr($s,0,1)) {
|
|
return $s if(81==length($s)); die("Bad compressed sudoku");
|
|
}; $s = substr $s,1;
|
|
while((length $os)<81) {
|
|
if($bc < 4) {
|
|
die("Compressed sudoku ends prrematurely") if($s eq "");
|
|
$i = index $squstr, substr($s, 0, 1); $s = substr($s,1);
|
|
die("Bad compressed sudoku") if($i == -1);
|
|
$n = ($i<<$bc) | $n; $bc +=6;
|
|
}
|
|
$bc -= 4; $i = $n & 15; $n = $n >> 4;
|
|
if($i < 10) {
|
|
$os .= ($i == 0?".":$i);
|
|
} else {
|
|
for($j=8;$j<$i;$j++) {$os .= '.';}
|
|
}
|
|
} return $os;
|
|
}
|
|
|
|
sub chksq($$) {
|
|
my $i = squish($_[0]); my $j = unsq($_[1]);
|
|
die("Squash check failed") if($i ne $_[1]);
|
|
die("Unsquash check failed") if($j ne $_[0]);
|
|
}
|
|
|
|
sub chk_fi($$) {
|
|
my $i; my $j; my $k = $_[1]; my $n= $_[0];
|
|
if($k) {
|
|
print "================== Inbuilt $n ==================\n";
|
|
$k = unsq($k);
|
|
} else {
|
|
print "================== File $n ==================\n";
|
|
$k = read_file("$n.sudoku");
|
|
}
|
|
die("*** Problem isn't even valid!") if(chk($k)==1);
|
|
print $k, "\n" if($vflg);
|
|
$i = read_proc('S', $k);
|
|
(length $i) == (81*$soff) or die("*** Failed!!!");
|
|
$i = substr $i,81*($soff-1),81;
|
|
die("*** Solution isn't even valid!") if(chk($i));
|
|
die("*** Solution doesn't fit the problem!") if(scmp($i,$k));
|
|
if(-f "$n.sol") {
|
|
$j = read_file("$n.sol");
|
|
die("*** 'Correct' solution isn't valid!") if(chk($j));
|
|
die("*** Mix-up - solution is for another problem!") if(scmp($j,$k));
|
|
($i eq $j) or die("*** Wrong answer!!!");
|
|
}
|
|
print "*** Correct answer\n";
|
|
}
|
|
|
|
sub chk_fail($$$$) {
|
|
my $i = $_[2]; my $e; my $n = $_[0]; my $c=$_[1]; my $o = $_[3];
|
|
print "================ Bad problem '$n' ================\n";
|
|
$i = unsq($i) if($i =~ /^#/);
|
|
$i = read_file("$n") unless(81 == length $i);
|
|
print $i . "\n" if($vflg);
|
|
die("*** Invalid file!") if(81 != length $i);
|
|
if($o eq 'I') {
|
|
die("*** Internal error - chk() passed invalid sudoku!")
|
|
if(chk($i)!=1);
|
|
}
|
|
$o = 'S' if($o ne 'U');
|
|
$e = read_proc($o, $i);
|
|
if($c) {
|
|
print "Expected '" . $c . "' got '" . $e . "'\n";
|
|
} else { return 2 unless((length $c) == 81);
|
|
return 0;
|
|
|
|
print "Got '" . $e . "'\n";
|
|
}
|
|
die("*** Didn't spot a bad problem!") if($e !~ /^!!! /);
|
|
die("*** Took too long to spot bad problem!") if($_[3] eq 'I' && $stkw);
|
|
die("*** Failed test!") if($c ne "" && $c ne $e);
|
|
print "*** Detected bad sudoku successfully\n";
|
|
}
|
|
|
|
sub genrand($$) {
|
|
my $i; my $j; my $k; my $s = $_[0]; my $c = $_[1];
|
|
if($s) {
|
|
print "================== #$s ==================\n";
|
|
} else {
|
|
print "================== Random ==================\n";
|
|
$s = int(rand(999999999)) unless($s);
|
|
}
|
|
$i = read_proc('G', $s);
|
|
(length $i) == (81*3) or die("*** Failed!!!");
|
|
$j = substr $i,81,81;
|
|
$k = substr $i,81*2,81;
|
|
print $k . "\n" . $j . "\n" if($vflg);
|
|
die("*** Problem isn't even valid!") if(chk($k)!=2);
|
|
die("*** 'Correct' solution isn't!") if(chk($j));
|
|
die("*** Solution doesn't fit the problem!") if(scmp($j,$k));
|
|
print "*** Generated problem OK\n";
|
|
|
|
$c = unsq($c) if($c);
|
|
if($c && ($c ne $k)) {
|
|
if($rflg) {
|
|
print "\n Sudoku generated was valid, but not the expected one.\n",
|
|
" This probably isn't serious, and may not even be an error.\n",
|
|
" To ignore this, add the -R option to the command line.\n\n";
|
|
die("*** Not expected sudoku!")
|
|
} else {
|
|
print "*** Not expected sudoku, but -R specified; ignoring\n";
|
|
}
|
|
}
|
|
|
|
$i = read_proc('S', $k);
|
|
(length $i) == (81*2) or die("*** Failed!!!");
|
|
$i = substr $i,81,81;
|
|
print $i . "\n" . $j . "\n" if($vflg);
|
|
($i eq $j) or die("*** Wrong answer!!!");
|
|
print "*** Correct answer\n";
|
|
}
|
|
|
|
sub scmp($$) {
|
|
my ($i,$a,$b);
|
|
for($i=0;$i<81;$i++) {
|
|
$a = substr $_[0], $i, 1;
|
|
$b = substr $_[1], $i, 1;
|
|
return 1 unless($a eq $b || $a eq "." || $b eq ".");
|
|
}; return 0;
|
|
}
|
|
|
|
sub chk($) {
|
|
my @a; my $n; my $i; my @v; my $c = 0;
|
|
for($n=0;$n<81;$n++) { $v[$n] = gi($_[0], $n); $c++ if($v[$n]); }
|
|
if($zoom) {
|
|
return 2 unless($c == 81);
|
|
return 0;
|
|
}
|
|
for($n=0;$n<81;$n++) { $a[$n] = 0; }
|
|
for($n=0;$n<81;$n++) {
|
|
next unless $v[$n];
|
|
$i = int($n/9)*9 + $v[$n]-1;
|
|
if($a[$i]) {
|
|
print "row ". int($n/9) . " many " . ${$v[$i]} . " \n";
|
|
return 1;
|
|
}; $a[$i] = 1;
|
|
}
|
|
for($n=0;$n<81;$n++) { $a[$n] = 0; }
|
|
for($n=0;$n<81;$n++) {
|
|
next unless $v[$n];
|
|
$i = ($n % 9)*9 + $v[$n]-1;
|
|
if($a[$i]) {
|
|
print "col ". (($n % 9)+1) . " many " . ${$v[$i]} . " \n";
|
|
return 1;
|
|
}; $a[$i] = 1;
|
|
}
|
|
for($n=0;$n<81;$n++) { $a[$n] = 0; }
|
|
for($n=0;$n<81;$n++) {
|
|
next unless $v[$n];
|
|
$i = ( int(($n % 9)/3)+int($n/27)*3 )*9 + $v[$n]-1;
|
|
if($a[$i]) {
|
|
print "box ". (int(($n % 9)/3)+int($n/27)*3+1) . " many " . ${$v[$i]} . " \n";
|
|
return 1;
|
|
}; $a[$i] = 1;
|
|
}
|
|
return 2 unless($c == 81);
|
|
return 0;
|
|
}
|
|
|
|
sub gi($$) {
|
|
my $n = substr $_[0], $_[1], 1;
|
|
$n = 0 if($n eq "."); $n = $n + 0;
|
|
return $n;
|
|
}
|
|
|
|
srand;
|
|
if(!$zoom) {
|
|
print "================ Unsquash Test ==============\n";
|
|
chksq(".............9.........1.............4..1..1....................2.."
|
|
. "...1..........", "#vnvGvTaox.u0xv");
|
|
chksq("........2.....5.3..58..7...326....158...........362..8..7...4.....5"
|
|
. "1....6...841..", "#PIdBjWoe7IGHF,8Yii6tUXBbLShC");
|
|
print "*** Passed\n"
|
|
}
|
|
if($fint) {
|
|
chk_fi("blank","#.......z");
|
|
chk_fi("tough1","#PIdBjWoe7IGHF,8Yii6tUXBbLShC");
|
|
chk_fi("insane1","#KxlV7Jds4.WOa53QQBCEEgz.gF");
|
|
chk_fi("insane2","#yTuoJQgMACknQkyi6AGEQJasobJMfpJ");
|
|
chk_fi("insane3","#LxVHGkHPvBCEEU7N697cyvBMLBpC");
|
|
chk_fi("insane4","#rAZf9MeZQ9QyjVAt2hst0SgUIc5iM");
|
|
chk_fi("insane5","#t0BU2SlN9oHkAVu9QqFjHIw4ECSRM");
|
|
chk_fi("wikipedia","#boHplm6Iqdaqkiu0hnapkejejKqpWp0C");
|
|
}
|
|
if($ffile) { foreach(glob("*.sudoku")) {
|
|
chk_fi($1,"") if(/^(.+)\.sudoku$/);
|
|
} }
|
|
if($fbad) {
|
|
chk_fail("row","!!! row 5","#vnvGvTaox.u0xv",'I');
|
|
chk_fail("col","!!! col 5","#vnvGvTa8.Gt0xv",'I');
|
|
chk_fail("box","!!! box 5","#vnvGe4kG..q0xv",'I');
|
|
chk_fail("tele13-mang.bad","","",'S') if(-f "tele13-mang.bad");
|
|
chk_fail("unique",'',"#.XwoFq3OixRhPPmooeL1Vw2iUo",'U')
|
|
}
|
|
if($fgen) {
|
|
genrand(951464,"#axiBBIPgN1RPQCEc4rDECkbYqome7A");
|
|
genrand(975900,"#GCnOKdlh.7BkvWCQwh.WcqBEoakC");
|
|
genrand(168996,"#tdjO0ahA3LbsmOg55K3G1wIY3Ses");
|
|
genrand(250762,"#s8GCxADk.WnpFq2KawIk6cVTu4HA");
|
|
genrand(909990524,"#t0BU2SlN9oHkAVu9QqFjHIw4ECSRM");
|
|
genrand(105761662,"#LxVHGkHPvBCEEU7N697cyvBMLBpC");
|
|
genrand(100440625,"#yTuoJQgMACknQkyi6AGEQJasobJMfpJ");
|
|
genrand(957749705,"#Q0GnEIAu1OEyHLaU6kXQeCy8e9G");
|
|
genrand(914809978,"#NCDJw9bt5RjGijAt2WhbN,EkQcAC");
|
|
genrand(774849286,"#soDgbcqF.D3a1mTiCHlBBkIQa,7Z0C");
|
|
genrand(862977530,"#xvTUcBJBnwWtHc0i6oyGM5jeYnrQK");
|
|
genrand(103980293,"#oKadABTt4vpO0.nGixnGQpEcashWmo");
|
|
genrand(122255857,"#34lWbkaAkBzr2rhelmblAyCEnS68G");
|
|
genrand(596684993,"#cB2DhAJcMSxiANgo1sBYJfKCpV.vko");
|
|
}
|
|
for($n = 0; $n<$gcnt; $n++) {
|
|
genrand(0,"");
|
|
}
|
|
print "\n######### All tests passed! #########\n\n";
|