Thursday, March 24, 2011

Print an array in clockwise direction

Original post has been deleted by the author.

Friday, March 11, 2011

Solve sudoku puzzle with logic and brute force

#!/usr/bin/perl -w
use strict;
# A perl script to solve sudoku puzzle using brute force
# Author: MH Wang

my ($file)=('problem.txt'); #input file containing sudoku puzzle matrix
#example of problem.txt (no leading # in the real file; uncompleted grids are filled with 0)
#0 0 0 0 0 0 2 0 0
#0 5 8 0 0 6 0 0 0
#0 0 0 3 0 0 0 8 5
#0 1 0 4 7 0 6 0 0
#9 0 6 0 0 0 5 0 7
#0 0 7 0 3 9 0 4 0
#7 6 0 0 0 8 0 0 0
#0 0 0 9 0 0 8 1 0
#0 0 9 0 0 0 0 0 0
my (@arr,%nums);

&readPuzzle(\@arr,$file);
&prtMatrix(\@arr);
&initialize(\@arr,\%nums);
&solve(\@arr,\%nums);
&prtMatrix(\@arr);

sub prtMatrix{
my $arr=$_[0];
for(my $i=0;$i<9;$i++){ j="0;$j<9;$j++){">[$j];
}
print "\n";
}
}
sub prtProb{
my ($nums,$toPrt)=@_;
$toPrt=0 if(! defined($toPrt));
my $nempty=0;
foreach my $k(keys %$nums){
foreach (keys %{$$nums{$k}}){
$nempty++;
if($toPrt){
print "$k-$_ ",(keys %{$$nums{$k}{$_}}),"\n";
}
}
}
print "$nempty empty cells\n" if($toPrt);
return($nempty);
}
sub readPuzzle{
my ($arr,$file)=@_;
open(FI,$file) || die "Can't open $file\n";
for(1..9){
chomp($_=<FI>);
push(@$arr,[split (/\s+/,$_)]);
}
close(FI)
}
sub initialize{ #to initialize all possible answers for every empty grid
my ($arr,$nums)=@_;
for(my $i=0;$i<9;$i++){ j="0;$j<9;$j++){" nempty="&logic_puzzle($arr,$nums);" nempty="="0);" itry="0;" nempty="&try_puzzle($arr,$nums,\$itry);">[2] <=> $b->[2]} @nem){
foreach (keys %{$$nums{$inem->[0]}{$inem->[1]}}){
my @rarr;
for(my $i=0;$i<@$arr;$i++){ my @xarr=@{$$arr[$i]}; $rarr[$i]=\@xarr; } my %rnums; foreach my $ir(keys %$nums){ foreach my $ic(keys %{$$nums{$ir}}){ foreach (keys %{$$nums{$ir}{$ic}}){ $rnums{$ir}{$ic}{$_}=$$nums{$ir}{$ic}{$_}; } } } $rarr[$inem->[0]][$inem->[1]]=$_;
delete($rnums{$inem->[0]}{$inem->[1]});
$nempty=&logic_puzzle(\@rarr,\%rnums);
if($nempty==0){
@$arr=@rarr;
%$nums=%rnums;
return($nempty);
}elsif($nempty>0){
$nempty=&try_puzzle(\@rarr,\%rnums,$itry);
if($nempty==0){
@$arr=@rarr;
%$nums=%rnums;
return($nempty);
}
}
}
return($nempty);
}
return(-1);
}
sub logic_puzzle{ # to iteratively eliminate, for each empty grid, answers incompatible with the numbers published in the puzzle
my ($arr,$nums)=@_;
my ($blkChk,$rowChk,$colChk);
my $nstep=0;
my $nempty=81;
do{
#print "Cycle ",++$nstep,"\n";
for(my $i=0;$i<9;$i=$i+3){ j="0;$j<9;$j="$j+3){" rv="chkBlk($arr,$nums,[$i..($i+2)],[$j..($j+2)]);" rv="="-1);" i="0;$i<9;$i++){" rv="chkBlk($arr,$nums,[$i],[0..8]);" rv="="-1);" rv="chkBlk($arr,$nums,[0..8],[$i]);" rv="="-1);" itmp="&prtProb($nums,0);" nempty="="$itmp);" nempty="$itmp;">0);
return ($nempty);
}
sub chkBlk{ #to check a 9-cell block
my ($arr,$nums,$row,$col)=@_;
my $blkChk=listNumbers($arr,$row,$col);
return(-1) if(exists($$blkChk{0})); #incomptatible
return(0) if(scalar keys %$blkChk==0); #a completed 3x3 block
foreach my $ii (@$row){
next if(! exists($$nums{$ii}));
foreach my $jj (@$col){
next if(! exists($$nums{$ii}{$jj}));
my @hkeys=keys %{$$nums{$ii}{$jj}};
foreach(@hkeys){
if(!exists($$blkChk{$_})){
delete($$nums{$ii}{$jj}{$_});
}else{
$$blkChk{$_}++; #to count the frequencies of undecided numbers
}
}
@hkeys=keys %{$$nums{$ii}{$jj}};
if(scalar @hkeys==1){
$$arr[$ii][$jj]=$hkeys[0];
delete($$blkChk{$hkeys[0]});
delete($$nums{$ii}{$jj});
}elsif(scalar @hkeys==0){
return -1;
}
}
}
my @bkeys=keys %$blkChk;
foreach my $bk (@bkeys){ #to look for singletons in undecided numbers, ie, frequency=1
next if $$blkChk{$bk}>1;
foreach my $ii (@$row){
next if(! exists($$nums{$ii}));
foreach my $jj (@$col){
if(exists($$nums{$ii}{$jj}) && exists($$nums{$ii}{$jj}{$bk})){
$$arr[$ii][$jj]=$bk;
delete($$blkChk{$bk});
delete($$nums{$ii}{$jj});
}
}
}
}
return 0
}
sub listNumbers{ #to list undecided numbers in a 9-cell block
my ($arr,$row,$col)=@_;
my %pr=map +($_=>0),1..9;
foreach my $ir (@$row){
foreach (@$col){
if($$arr[$ir]->[$_]>0){
if(! exists($pr{$$arr[$ir]->[$_]})){
return {0=>0};
#print "Not a valid puzzle. Check row ",$ir+1," column ",$_+1,"\n";
#exit;
}
delete($pr{$$arr[$ir]->[$_]});
}
}
}
return \%pr;
}