#!/usr/bin/perl use strict; my @base=( [0,0,9,0,0,0,0,0,4], [0,0,0,9,8,0,0,5,0], [0,0,0,0,6,1,0,0,7], [0,0,5,0,3,7,2,0,0], [0,1,0,0,2,0,0,4,0], [0,0,2,6,1,0,7,0,0], [3,0,0,8,5,0,0,0,0], [0,8,0,0,9,6,0,0,0], [6,0,0,0,0,0,8,0,0] ); # @base=( # [0,0,4,6,0,0,7,0,0], # [0,0,1,4,0,7,0,6,0], # [9,0,0,0,3,0,8,2,0], # [8,4,0,0,0,0,0,0,0], # [0,0,9,0,6,3,0,0,0], # [0,0,2,5,9,0,0,0,7], # [0,0,7,0,0,1,2,0,0], # [1,0,3,2,7,0,6,0,5], # [5,0,0,0,0,0,9,7,0] # ); # @base=( # [0,2,0,0,0,9,6,0,0], # [0,5,6,0,0,0,8,3,0], # [3,0,0,0,0,0,1,0,0], # [4,0,0,0,9,0,3,2,6], # [8,0,0,0,4,1,0,7,0], # [0,0,3,0,0,5,4,0,0], # [0,0,0,0,0,0,0,0,0], # [0,0,1,0,8,0,0,6,3], # [6,9,8,0,7,0,0,1,0] # ); my $ot=time(); my $obj=make_obj(\@base); show($obj); print "\nBerechne Lösung...\n"; my $back; ($obj,$back)=run($obj,0); print "für mich nicht lösbar!\n" if($back<81); show($obj); my $nt=time(); print "\n".($nt-$ot)." Sekunden\n"; exit(0); ############ # Funtionen ############ sub run($$) { my ($obj,$deep)=@_; # print "DEEP:".($deep+0)."\n"; my $exit=0; my $cnt=0; while($exit<=0) { $cnt=0; my $change=0; # vergleichen for my $i (@{$obj->{'points'}}) { if($i->{'wert'}==0) { my @can=get_can($i); if(@can==1) { $i->{'wert'}=shift(@can); $change++; } } else { $cnt++; } } # nichts gefunden if($change==0 && 81>$cnt) { # clone erzegen my $tmp=make_obj([get_matrix($obj)]); my $found=0; my $x=-1; my $y=-1; # Feld mit zwei Möglichkeiten finden for my $i (@{$tmp->{'points'}}) { if($i->{'wert'}==0) { my @can=get_can($i); if(@can==2) { $x=$i->{'x'}; $y=$i->{'y'}; $i->{'wert'}=shift(@can); $change++; last(); } } } #was gefunden if($change) { my $back; ($tmp,$back)=run($tmp,$deep+1); if($back==81) { $obj=$tmp; $cnt=81; $exit=1; } else { for my $i (@{$obj->{'points'}}) { if($i->{'x'}==$x && $i->{'y'}==$y) { my @can=get_can($i); $i->{'wert'}=pop(@can); last(); } } } } else { $exit=1; } } $exit=1 if($change==0); $exit=1 if($cnt==81); } return($obj,$cnt); } sub make_obj($) { my ($get)=@_; my $obj= { 'cluster'=>[ [[],[],[]], [[],[],[]], [[],[],[]] ], 'cols'=>[], 'rows'=>[], 'points'=>[] }; for(my $i=0; $i<9; $i++) { ${$obj->{'cols'}}[$i]=[]; } for(my $i=0; $i<9; $i++) { ${$obj->{'rows'}}[$i]=[]; } my $c=0; my $a=0; for(my $i=0; $i<@{$get}; $i++) { my @sub=(); for(my $ii=0; $ii<@{$$get[$i]}; $ii++) { my $point={ 'wert'=>$$get[$i][$ii], 'cluster'=>${$obj->{'cluster'}}[int($i/3)-1][int($ii/3)-1], 'col'=>${$obj->{'cols'}}[$ii], 'row'=>${$obj->{'rows'}}[$i], 'x'=>$i, 'y'=>$ii }; push(@{${$obj->{'cluster'}}[int($i/3)-1][int($ii/3)-1]},$point); # print "POS=(".$i.",".$ii."); CLUSTER:[".(int($i/3))."][".(int($ii/3))."]\n"; push(@{${$obj->{'cols'}}[$ii]},$point); push(@sub,$point); } push(@{$obj->{'points'}},@sub); push(@{${$obj->{'rows'}}[$i]},@sub); } return $obj; } sub get_can($) { my ($i)=@_; my @can=(1..9); # print "\n COL: "; for my $ii (@{$i->{'col'}}) { # print $ii->{'wert'}.","; $can[$ii->{'wert'}-1]=0 if($ii->{'wert'}>0); } # print "\n ROW: "; for my $ii (@{$i->{'row'}}) { # print $ii->{'wert'}.","; $can[$ii->{'wert'}-1]=0 if($ii->{'wert'}>0); } # print "\n CLS: "; for my $ii (@{$i->{'cluster'}}) { # print $ii->{'wert'}.","; $can[$ii->{'wert'}-1]=0 if($ii->{'wert'}>0); } # print "\n "; for(my $ii=8; $ii>=0; $ii--) { splice(@can,$ii,1) if($can[$ii]==0); } return @can; } sub get_matrix($) { my ($in)=@_; my @mx=([1..9],[1..9],[1..9],[1..9],[1..9],[1..9],[1..9],[1..9],[1..9]); for my $i (@{$in->{'points'}}) { if($i->{'wert'}>0) { $mx[$i->{'x'}][$i->{'y'}]=$i->{'wert'}; } else { $mx[$i->{'x'}][$i->{'y'}]=0; } } return @mx; } sub show($) { my ($in)=@_; my @mx=get_matrix($in); my $d=1; print "\nSUDOKU:\n"; print "+-------+-------+-------+\n"; for(my $i=0; $i<@mx; $i++) { if(int($i/3)==$d) { print "+-------+-------+-------+\n"; $d++; } print "| "; my $c=1; for(my $ii=0; $ii<@{$mx[$i]}; $ii++) { if(int($ii/3)==$c) { print "| "; $c++; } print $mx[$i][$ii]." "; } print "|\n" } print "+-------+-------+-------+\n"; }