OMG, NATÜRLICH *Schuppen von den Augen fall*Zitat:
die Zelle mit der kleinsten Menge zu nehmen und mit jeder Ziffer die Lösung zu prüfen.
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
Jetzt halt wieder mit getNextFreeField-Funktion, die die Position mit den wenigsten Möglichkeiten (oder -1, -1 beim Ende des Feldes) returned. Supi, \o/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
}
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:
Edit: Ich glaube inzwischen kann man den Thread dank meiner "perl-pollution" bereits in "Skriptsprachen" verschieben...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