die Zelle mit der kleinsten Menge zu nehmen und mit jeder Ziffer die Lösung zu prüfen.
OMG, NATÜRLICH *Schuppen von den Augen fall*
Das schränkt die Anzahl der durchzugehenden Möglichkeiten ja astronomisch ein.
Damn, die Idee ist so gut, die hab ich dir gleich mal geklaut :P
Jetzt schafft der Algo das "Qassim Hamza" in 22 Sekunden :D
Code:
sub getSec {
my ($x, $y, @sudoku) = @_;
my @sector;
my $intX = 3*int($x/3);
my $intY = 3*int($y/3);
foreach my $i ($intY..$intY+2) {
foreach my $j ($intX..$intX+2) {
if (${sudoku[$i][$j]}) {push(@sector, ${sudoku[$i][$j]})}
}
}
return @sector
}
sub getValidDigits {
my ($x, $y, @sudoku) = @_;
my @row = grep(($_), @{$sudoku[$y]});
my @col = map {${sudoku[$_][$x]} ? ${sudoku[$_][$x]} : ()} (0..8);
my @sec = getSec($x, $y, @sudoku);
my %digitPresence = map {$_, 1} (@row, @col, @sec);
return grep $_ ne '' && !exists $digitPresence{$_}, (1..9)
}
sub getNextFreeField {
my @sudoku = @_;
my ($nextX, $nextY) = (-1, -1);
my $count = 10;
foreach my $y (0..8) {
foreach my $x (0..8) {
unless (${sudoku[$y][$x]}) {
my @validDigits = getValidDigits($x, $y, @sudoku);
if (@validDigits < $count) {
($nextX, $nextY) = ($x, $y);
$count = @validDigits
}
}
}
}
return ($nextX, $nextY)
}
sub useBruteforce {
my ($x, $y, @sudoku) = @_;
my ($nextX, $nextY) = getNextFreeField(@sudoku);
unless ($nextX == -1) {
foreach (getValidDigits($nextX, $nextY, @sudoku)) {
${sudoku[$nextY][$nextX]} = $_;
if (useBruteforce($nextX, $nextY, @sudoku)) {return 1}
}
${sudoku[$nextY][$nextX]} = 0;
return 0
}
return 1
}
Jetzt halt wieder mit getNextFreeField-Funktion, die die Position mit den wenigsten Möglichkeiten (oder -1, -1 beim Ende des Feldes) returned. Supi, \o/
BTW: zu meinem früher geposteten code: Ich habe da zwei Undinge gemacht, die sich gegenseitig aufgehoben haben. (#perl told me!) Nämlich einmal Funktionen als (mit?) Prototypen deklariert, die keine Argumente annehmen (sub foo(){...}) und danach beim Aufrufen perl gesagt, er solle das doch bitte einfach ignorieren (&foo(@args)). Also ich häng mal das neue Skript an mein älteres Post an. (Mit neuem Algo und "richtigerer" Syntax..)
Ansonsten geht auch diese bash Zeile zum "bereinigen" der unsauberen Syntax:
Code:
cat sudoku.pl.txt | \
perl -pe 's/^(sub \w+)\(\)/$1/;s/(?<!\\|&)&(\w+)(?=\()/$1/g;s/(?<!\\|&)&(\w+)(?!\()/$1()/g' \
> tmp.lol && mv tmp.lol sudoku.pl.txt
Edit: Ich glaube inzwischen kann man den Thread dank meiner "perl-pollution" bereits in "Skriptsprachen" verschieben...
Lesezeichen