µit - März

BlackMail

Unglaublich! Wie hast Du denn das hingekriegt? Ich wüsste nicht, wo ich noch so viel Zeit rausholen sollte ...
Ich versuch's trotzdem

Mein erster BT-Benchmark:

Spoiler anzeigen

Sudoku Backtrack 1 Richtig - Benötigte Zeit: 727.816803532293
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 1144.42478024442
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 283.632137604081
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 380.589711820916
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 10084.2537249846
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 283.030943876945
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 117.756027651559
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 1293.89545319307
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 312.322376167921
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 1085.08986477332

Ergebnis Backtrack: Zeit gesammt: 15712.8118238491 Zeit Durchschnitt: 1571.28118238491

Da gibt's wohl auch noch etwas zu tun!

Gruß BlackMail.

**Andy**

Zitat

Unglaublich! Wie hast Du denn das hingekriegt? Ich wüsste nicht, wo ich noch so viel Zeit rausholen sollte ...

Hab mal die einzelnen Sequenzen im Programmablauf von der Zeit her analysiert, da hat mich beinahe der Schlag getroffen.
bsp: Lösungszeit für ein einfachstes Sudoku (logisch, Lösung nur durch finden der einmalig vorkommenden Möglichkeit in einer Zeile) gesamt: 300ms.

Einzelzeiten:
Sudokustring einlesen und die Ziffern in ein Array schreiben, die leeren Felder mit 1-9 ausfüllen.....10ms
Array zum Lösen vorbereiten, d.h. in den "leeren" Feldern die Möglichkeiten eliminieren, d.h. jeweils nur eine Ziffer in Zeile/Spalte/Box, also das "jungfräuliche" Sudoku auf dem Papier.....240ms
Der eigentliche Lösungsvorgang (finde alle nur einmal in der Spalte/Zeile vorkommenden Möglichkeiten) per Funktion _soloincol(), ca 60 Ziffern in . ..... 35ms
Restzeit von einigen Millisekunden für das Prüfen der Lösung und Ausgabe...15ms

Uber 240ms, d.h, 2/3 der kompletten Zeit wurde bei mir verbraten, nur um das Array für die Lösung vorzubereiten . Da musste der Wurm drin sein! So wars auch, ein dezentes IF an der richtigen Stelle wirkt Wunder, sodann geschmeidig auf die F5-Taste gehämmert und schwupp wurden aus den 240ms nur noch 90
Neue Gesamtlösungszeit: 150ms => Geschwindigkeit verdoppelt!
Gut, so einfach geht es leider nicht immer, zzt hänge ich an den hidden Triples, diese Funktion dauert bei mir zumindest laaaaange, ich hoffe da auf die stringregexpr()-Spezialisten unter euch, da sollte was machbar sein .....

**eukalyptus**

Na dann werd ich mich auch mal bemühen, etwas Geschwindigkeit gutzumachen

btw.: ich hab auch ein reines BT-Script geschrieben.
insgesammt 44 Zeilen
Man beachte Logisch Nr.: 4 und das leere Sudoku BackTrack Nr.: 10

Spoiler anzeigen

Code

Sudoku Logisch 1 Richtig - Benötigte Zeit: 62.6152206495518
Sudoku Logisch 2 Richtig - Benötigte Zeit: 23.2518378732493
Sudoku Logisch 3 Richtig - Benötigte Zeit: 38.6174779196797
Sudoku Logisch 4 Richtig - Benötigte Zeit: 20.3076089279503
Sudoku Logisch 5 Richtig - Benötigte Zeit: 30.7047404069512
Sudoku Logisch 6 Richtig - Benötigte Zeit: 5525.45980005839
Sudoku Logisch 7 Richtig - Benötigte Zeit: 773.753926825896
Sudoku Logisch 8 Richtig - Benötigte Zeit: 7149.75506663556
Sudoku Logisch 9 Richtig - Benötigte Zeit: 2557.18925170657
Sudoku Logisch 10 Richtig - Benötigte Zeit: 5812.10405233067


Ergebnis Logisch: Zeit gesammt: 21993.7589833345 Zeit Durchschnitt: 2199.37589833345


Sudoku Backtrack 1 Richtig - Benötigte Zeit: 1765275.2981175
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 3151.57373353317
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 1263.15970325838
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 12333.7896296876
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 6219.82486600951
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 4814.80635108652
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 186393.929954785
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 3464.58753836032
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 3146.24987253967
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 194.844596170742


Ergebnis Logisch: Zeit gesammt: 21993.7589833345 Zeit Durchschnitt: 2199.37589833345
Ergebnis Backtrack: Zeit gesammt: 1986258.06436293 Zeit Durchschnitt: 198625.806436293
Ergebnis gelöste Sudokus: 20

Alles anzeigen

Jedoch für BT Nr.:1 braucht der Algo fast 30 min
und das haut mir den ganzen Schnitt zusammen...

lgE

**Andy**

langsam wirds was.....

Spoiler anzeigen

Code

Sudoku Logisch 1 Richtig - Benötigte Zeit: 41.9824307279277
Sudoku Logisch 2 Richtig - Benötigte Zeit: 36.8063538801719
Sudoku Logisch 3 Richtig - Benötigte Zeit: 37.0792935973706
Sudoku Logisch 4 Richtig - Benötigte Zeit: 37.8369317888167
Sudoku Logisch 5 Richtig - Benötigte Zeit: 37.0097316837754
Sudoku Logisch 6 Richtig - Benötigte Zeit: 53.7353211092471
Sudoku Logisch 7 Richtig - Benötigte Zeit: 54.037594163504
Sudoku Logisch 8 Richtig - Benötigte Zeit: 108.977817013056
Sudoku Logisch 9 Richtig - Benötigte Zeit: 52.7798924164943
Sudoku Logisch 10 Richtig - Benötigte Zeit: 52.3301145816019


Ergebnis Logisch: Zeit gesammt: 512.575480961966 Zeit Durchschnitt: 51.2575480961966


Sudoku Backtrack 1 Richtig - Benötigte Zeit: 578.548949657009
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 1274.71787615465
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 218.915253195588
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 710.951252184286
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 196.600126552397
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 80.6689118309729
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 524.099012584002
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 206.273143653733
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 1264.2746494317
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 284.52442978088


Ergebnis Logisch: Zeit gesammt: 512.575480961966 Zeit Durchschnitt: 51.2575480961966
Ergebnis Backtrack: Zeit gesammt: 5339.57360502522 Zeit Durchschnitt: 533.957360502522
Ergebnis gelöste Sudokus: 20

Alles anzeigen

eukalyptus
fetten RESPEKT von mir! Für reines BT sieht das schon ziemlich schnell aus.
ABER! Bei "passenden" Sudokus ist Backtrack sehr schnell, bei einigen kann BT mithalten, und wenn die Sudokus "böse" sind, dann gute Nacht....
Böse Sudokus:

Spoiler anzeigen

Zitat

500080200740000000000000000002050000000600007800000040060700000001000500000304000
602050000000003040000000000430008000010000200000000700500270000000000081000600000
602050000000004030000000000430008000010000200000000700500270000000000081000600000
602700000000800130000000090400000700030090000000010000500400600010000020000000000
700080000000000104000000200000102000200000030000400500051030000000006070040000000
000701600500080000000000000000600701208090000400000000000020050070300000000000080
002100400083000000000000000500400700600020000010000000000008063100700000000000080
000800001900000500000000000410050000003000080000000700000108040020300000500000600
051000000000300080000070000020501006800000040000700000000000201300040000000000500

Alles anzeigen

**Andy**

Hallo zusammen,

ich bin bis heute Abend off, dann stelle ich mein Script einfach hier in den Thread.

ciao und schönen Tag
Andy

BlackMail

Zitat von eukalyptus

Wer macht eigentlich die Auswertung?
Dieser Jemand soll dann Sudokus für die Analyse auswählen.
Und auch entscheiden, nach welchen Kriterien bewertet werden soll.

Ich denke, es wird keinen "besten" Solver geben, sondern mehrere...
Den Solver mit der schönsten Strategie (unabhängig von der Geschwindigkeit)
Den Solver, der im Durchschnitt am schnellsten löst
Den programmiertechnisch schnellsten Solver
Den schönsten, reinen Backtracker
usw...

Und daraus kombinieren wir dann die besten Elemente zu einem gescheiten Solver.

lgE

Alles anzeigen

Klingt gut.
Abgabe morgen? Als passwortgeschütztes Archiv? Wer die Auswertung dann macht, können wir ja dann immer noch bestimmen.
Wir können auch alle 40000 durchlaufen lassen. Scheinen ja nur wir 3 übrig geblieben zu sein ...
In unterschiedlichen Kategorien zu bewerten, ist auch eine gute Idee.

Gruß BlackMail.

**Andy**

Hi,
ok, Abgabe morgen, aber das mit dem Archiv schenk ich mir^^
Wir tauschen die Scripte aus und jeder lässt dann die ersten 5.000 oder 10.000 Sudokus aus der Liste mit den Scripten der anderen Teilnehmer durchlaufen.
So haben wir mehrere Ergebnisse auf verschiedenen Rechnern. Ich habe nämlich festgestellt, daß mein Sudokuscript und auch andere Autoit-Projekte relativ anfällig auf die "Aktivität" des Rechners reagieren. Beim Lösen immer derselben 10 Sudokus waren teilweise Zeitunterschiede von bis zu 100% feststellbar.
ciao
Andy

**funkey**

Hallo Sudoku-Spezialisten.
Ich hatte zwar auch angefangen, ein Sudoku-Löseprogramm zu schreiben, aber mich hat ziemlich früh die Lust verlassen, das ganze auch zu beenden, sorry.
Somit stelle ich hier mein Skript rein, wie ich es schon am 21.03. bereits hatte. Ohne direkte Schnittstelle für den Benchmark, aber mit grafischer Oberfläche.
Mein Skript löst einfache Sudokus, kann aber kein Backtracking.

Gratulation an alle, die länger bei der Sache geblieben sind, und ihre Skripte extrem verfeinert haben. Ihr seid super!

L3viathan

Bei mir ist es genau wie bei Funkey: Bloß hat mich nicht die Lust, sondern das Können verlassen.
Hier meine Version, mit grafischer Oberfläche, ohne Benchmarkanbindung, ohne Backtracking...

**Andy**

Hallo,
anbei mein "Brocken", die GUI ist abgeschaltet, bzw war nur zum verfolgen des Lösungswegs implementiert.
Nach dem auskommentieren der Zeile 158 kann man in der Konsole die Lösungen verfolgen, ungelöste Sudokus werden in eine Datei geschrieben.

ciao
Andy

autoit.de/wcf/attachment/4599/

**eukalyptus**

Hier sind meine Scripte

Der logische Solver:autoit.de/wcf/attachment/4600/
Hier hab ich die Methode_5(hidden pairs/tribbles) abgeschaltet, da sie manchmal fehlerhaft arbeitet!
Hab das Problem noch nicht gefunden...

Der reine Backtracker:autoit.de/wcf/attachment/4601/

lgE

**Andy**

eukalyptus
Klasse Idee, die Möglichkeiten mit BitAND zu vergleichen und mit BitXOR zu eliminieren, hat mich einige Minuten und 2 Tassen Kaffe gekostet um überhaupt zu kapieren was da vor sich geht^^
Leider rennt sich dein Backtrack-Algorithmus zu Tode, ich hätte gern mal die ersten 5000 Sudokus aus der Liste durchlaufen lassen aber schon beim achten Sudoku habe ich nach 1/4h rechnen ohne Lösung abgebrochen.

Nach dem neidvollen Sichten eurer "schönen" Guis hat mich jetzt doch der Ehrgeiz gepackt, wenigstens eine "sichtbare" Lösungsfindung anzubieten^^...morgen.....vielleicht.....

**eukalyptus**

Die Methode mit BitAnd, BitOr und BitXor ist schneller als StringInStr und StringReplace.
Allerdings auch langsamer als so ein Array: $aSudoku[9][9][9] ($aSudoku[x][y][val])

Ich kann mich leider nicht mehr erinnern, weshalb ich nicht das Array genommen hab?!?
Irgendeinen Grund hatte es...

SpeedTest:

Spoiler anzeigen

[autoit]

Global $iCnt = 100
Global $aSudoku[9][9][9], $sSudoku[9][9], $bSudoku[9][9], $iTimer
For $i = 0 To 8
For $j = 0 To 8
For $k = 0 To 8
$aSudoku[$i][$j][$k] = 1
$sSudoku[$i][$j] &= $i
$bSudoku[$i][$j] = BitOR($bSudoku[$i][$j], 2 ^ $i)
Next
Next
Next

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
If $aSudoku[$k][$l][$iValue] Then ContinueLoop
Next
Next
Next
Next
ConsoleWrite("ARRAY" & @TAB & "Möglichkeit vorhanden " & TimerDiff($iTimer) & @LF)

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
If StringInStr($sSudoku[$k][$l], $iValue) Then ContinueLoop
Next
Next
Next
Next
ConsoleWrite("STRING" & @TAB & "Möglichkeit vorhanden " & TimerDiff($iTimer) & @LF)

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
If BitAND($bSudoku[$k][$l], 2 ^ $iValue) Then ContinueLoop
Next
Next
Next
Next
ConsoleWrite("BIT" & @TAB & "Möglichkeit vorhanden " & TimerDiff($iTimer) & @LF)

[/autoit] [autoit][/autoit] [autoit]

ConsoleWrite(@LF)

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
$aSudoku[$k][$l][$iValue] = 0
Next
Next
Next
Next
ConsoleWrite("ARRAY" & @TAB & "Möglichkeit löschen " & TimerDiff($iTimer) & @LF)

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
$sSudoku[$k][$l] = StringReplace($sSudoku[$k][$l], $iValue, "")
Next
Next
Next
Next
ConsoleWrite("STRING" & @TAB & "Möglichkeit löschen " & TimerDiff($iTimer) & @LF)

[/autoit] [autoit][/autoit] [autoit]

$iTimer = TimerInit()
For $i = 1 To $iCnt
For $iValue = 0 To 8
For $k = 0 To 8
For $l = 0 To 8
If BitAND($bSudoku[$k][$l], 2 ^ $iValue) Then $bSudoku[$k][$l] = BitXOR($bSudoku[$k][$l], 2 ^ $iValue)
Next
Next
Next
Next
ConsoleWrite("BIT" & @TAB & "Möglichkeit löschen " & TimerDiff($iTimer) & @LF)

[/autoit]

Naja - Mein Script ist auch mit der vermeintlich schnelleren Methode langsamer als deines

Mein reiner Backtracker benötigt für das 1 BT-Sudoku aus dem Benchmark über 30 min!
dafür löst er die restlichen (vom Benchmark) ziemlich schnell.
Mit anderen Sudokus hab ich den gar nicht ausprobiert...

Wenn ich mal mehr Zeit hab, werd ich mir eure Solver mal genauer ansehen -bin schon gespannt

lgE

BlackMail

Spoiler anzeigen

[autoit]

Global Const $__DEBUG__ = false ;#__DEBUG__
;~Global Const $__DEBUG__ = true ;#__DEBUG__
Global Const $__TIME__ = false ;#__TIME__ ; Zeitmessung
;~Global Const $__TIME__ = true ;#__TIME__ ; Zeitmessung
Global Const $__BT__ = false ;#__BT__ ; Backtracking
;~Global Const $__BT__ = true ;#__BT__ ; Backtracking

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; ==============
; Version 1.06
; ==============

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Historie:
; ==============================

[/autoit] [autoit][/autoit] [autoit]

; - Version 1.01: Backtracking immer ausgehend von Zellen mit möglichst wenigen Werten
; - Version 1.02: Beim Backtracking nur noch Single-Strategien zulassen
; - Version 1.03: Beim Backtracking Zelle aus Unit mit vielen offenen Werten nehmen
; - Version 1.04: _Singles insb. _deleteValueFromUnits etwas verbessert
; - Version 1.05: _HiddenSingles etwas verbessert
; - Version 1.06: _deleteValueFromUnits leicht verbessert, _prepare leicht verbessert

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

#include <Array.au3>

[/autoit] [autoit][/autoit] [autoit]

; TODO:
; - merken, welche 2er/3er schon abgearbeitet sind
; - PP/BL-Reduktion
; - Y-Wing

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

AutoItSetOption("MustDeclareVars", 1)

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;********************************************** Variablen ***************************************

[/autoit] [autoit][/autoit] [autoit]

Global $sProblemCells ; Zellen mit Startaufstellung (nur für Ausgabe)

[/autoit] [autoit][/autoit] [autoit]

Global $gaSudoku[81]
;8
;~_SolveSudoku('000000000005010700070602090009020800060835010004070500030408020001090400000000000')

[/autoit] [autoit][/autoit] [autoit]

;********************************************** Hauptprogramm ***************************************

[/autoit] [autoit][/autoit] [autoit]

Func _SolveSudoku($problem, $output = false)

[/autoit] [autoit][/autoit] [autoit]

local $sSingles ; Liste mit Zellindizes mit Einzelwerten
local $sOpenCells ; offene Zellen

[/autoit] [autoit][/autoit] [autoit]

Local $solution ; Lösungsstring
Local $hdlFile ; Filehandle (nur für Ausgabe)

[/autoit] [autoit][/autoit] [autoit]

local $time

[/autoit] [autoit][/autoit] [autoit]

if $__TIME__ then $time = TimerInit()
_init($output, $hdlFile, $sSingles, $sOpenCells, $sProblemCells, $gaSudoku)
if $__TIME__ then
$time = TimerDiff($time)
ConsoleWrite("Init: " & $time & @crlf)
endif

[/autoit] [autoit][/autoit] [autoit]

; Startaufbau + mögliche Werte
if $__TIME__ then $time = TimerInit()
_prepare($problem, $gaSudoku, $sSingles, $sOpenCells)
if $__TIME__ then
$time = TimerDiff($time)
ConsoleWrite("Prepare: " & $time & @crlf)
endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

If $output Then
; Startaufstellung
_outputHeading($hdlFile, "Start")
_outputTable($hdlFile, $gaSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

; Startaufstellung + mögliche Werte
_outputHeading($hdlFile, "Mögliche Werte")
_outputTable($hdlFile, $gaSudoku, $sOpenCells, True)
EndIf

[/autoit] [autoit][/autoit] [autoit]

; Lösen
if $__TIME__ then $time = TimerInit()
$solution = _solve($output, $hdlFile, $gaSudoku, $sSingles, $sOpenCells)
if $__TIME__ then
$time = TimerDiff($time)
ConsoleWrite("Solve: " & $time & @crlf)
endif
;~ $solution = _BackTrack($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)
if $output then
If $solution <> -1 Then
if $__DEBUG__ then ConsoleWrite("************************ SUDOKU gelöst!!! ******************************" & @CRLF)
Else
if $__DEBUG__ then ConsoleWrite("Sudoku leider nicht gelöst!!!" & @CRLF)
EndIf
; Ende (Datei schließen)
_outputEnd($hdlFile)
EndIf

[/autoit] [autoit][/autoit] [autoit]

return _ArrayToString($gaSudoku, "")

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_SolveSudoku

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Lösen durch Wechsel der Strategien
; returns 0, wenn erfolgreich und -1, wenn nicht
Func _solve(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells, $btCount = 0)

[/autoit] [autoit][/autoit] [autoit]

const $maxStrat = 6
local $stratCount = $maxStrat
Local $strategie = 1
Local $ret
Local $step = 1
local $failureCount
local $time

[/autoit] [autoit][/autoit] [autoit]

While 1

[/autoit] [autoit][/autoit] [autoit]

if $__DEBUG__ then ConsoleWrite("Step: " & StringFormat("%3d", $step))

[/autoit] [autoit][/autoit] [autoit]

if $__TIME__ then $time = TimerInit()

[/autoit] [autoit][/autoit] [autoit]

; Einzelwerte (solved squares)
If $strategie = 1 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _Singles($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)
if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

; nix gefunden
If $sSingles = "" Then $strategie = 2

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; versteckte Einzelwerte
ElseIf $strategie = 2 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _HiddenSingles($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)
if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

if $sSingles <> "" then
$strategie = 1
elseIf $ret = 0 Then
$strategie = 3
endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Naked Doubles
ElseIf $strategie = 3 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _Doubles($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

; gibt es neue Einzelwerte durch Naked Doubles?
if $sSingles <> "" then
$strategie = 1
else
$strategie = 4
endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Naked Triples
ElseIf $strategie = 4 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _Triples($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

; gibt es neue Einzelwerte durch Naked Triples?
if $sSingles <> "" then
$strategie = 1
else
$strategie = 5
endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Hidden Doubles
ElseIf $strategie = 5 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _HiddenDoubles($output, $hdlFile, $aSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

; durch Hidden-Strategien (außer Hidden-Singles) können keine Einzelwerte entstehen
if $ret > 0 then
$strategie = 2
else
$strategie = 6
endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Hidden Triples
ElseIf $strategie = 6 Then

[/autoit] [autoit][/autoit] [autoit]

$ret = _HiddenTriples($output, $hdlFile, $aSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

; durch Hidden-Strategien (außer Hidden-Singles) können keine Einzelwerte entstehen
;~ if $ret > 0 then
$strategie = 2
;~ else
;~ $strategie = 7
;~ endif

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;~ ; Pointing Pairs / Box-Line-Reduction
;~ elseif $strategie = 7 then

[/autoit] [autoit][/autoit] [autoit]

;~ $ret = _PP_BL_Reduction($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

;~ if $__DEBUG__ then ConsoleWrite(" Strategie: " & $strategie & " ret: " & $ret)

[/autoit] [autoit][/autoit] [autoit]

;~ if $sSingles <> "" then
;~ $strategie = 1
;~ elseIf $ret = 0 Then
;~ $strategie = 2
;~ endif

[/autoit] [autoit][/autoit] [autoit]

EndIf

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zeitmessung
if $__TIME__ then
$time = TimerDiff($time)
if $__Debug__ then consoleWrite(" Zeit: " & $time & @crlf)
else
if $__Debug__ then consoleWrite(@CRLF)
endif

[/autoit] [autoit][/autoit] [autoit]

If StringLen($sOpenCells) = 0 Then
Return 0
EndIf

[/autoit] [autoit][/autoit] [autoit]

; Beim Backtracking Anzahl der Strategien begrenzen
if $btCount > 0 then
$stratCount = 2
else
$stratCount = $maxStrat
endif

[/autoit] [autoit][/autoit] [autoit]

; nix gefunden
if $ret = 0 then

[/autoit] [autoit][/autoit] [autoit]

; $stratCount Fehlversuche
$failureCount += 1

[/autoit] [autoit][/autoit] [autoit]

if $failureCount >= $stratCount then
; letzter Rettungsanker: Ergebnis rekursiv erraten
$ret = _BackTrack($output, $hdlFile, $aSudoku, $sSingles, $sOpenCells, $btCount)
$strategie = 1
; 0, wenn erfolgreich; - 1 sonst
return $ret
endif

[/autoit] [autoit][/autoit] [autoit]

; Strategie war erfolgreich: Fehlerzähler zurücksetzen
elseif $ret > 0 then
$failureCount = 0

[/autoit] [autoit][/autoit] [autoit]

; Fehler: evtl. Widerspruch beim Backtracking
elseIf $ret = -1 then
if $__DEBUG__ or $__BT__ then consolewrite("FEHLER!!!! $ret = " & $ret & @crlf)
return $ret
endif

[/autoit] [autoit][/autoit] [autoit]

$step += 1

[/autoit] [autoit][/autoit] [autoit]

WEnd

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_solve

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;*********************************************** Initialisierung *************************************************

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _init(byref $output, ByRef $hdlFile, byref $sSingles, byref $sopencells, byref $sProblemCells, byref $aSudoku)

[/autoit] [autoit][/autoit] [autoit]

If $output Then
_outputStart($hdlFile)
EndIf

[/autoit] [autoit][/autoit] [autoit]

; globale Daten initialisieren
dim $aSudoku[81]
$sSingles = ""
$sOpenCells = ""
$sProblemCells = ""

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_init

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;********************************************** Datenzugriff + Manipulation ***************************************

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _prepare(ByRef $problem, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

Local $num
Local $cell, $row, $col, $box

[/autoit] [autoit][/autoit] [autoit]

Local $aUnitUsedValues[27] ; verwendete Werte

[/autoit] [autoit][/autoit] [autoit]

; Zahlen in SudokuMatrix eintragen und offene Zellen sammeln
For $cell = 0 To 80

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

$num = StringMid($problem, $cell + 1, 1)

[/autoit] [autoit][/autoit] [autoit]

If Number($num) = 0 Then
$aSudoku[$cell] = '123456789'
_appendCellToString($cell, $sOpenCells)
ContinueLoop
else
_getCellDetails($cell, $row, $col, $box)

[/autoit] [autoit][/autoit] [autoit]

$aSudoku[$cell] = $num
$aUnitUsedValues[$row] &= $num
$aUnitUsedValues[$col+9] &= $num
$aUnitUsedValues[$box+18] &= $num

[/autoit] [autoit][/autoit] [autoit]

_appendCellToString($cell, $sProblemCells)
endif

[/autoit] [autoit][/autoit] [autoit]

for $num = 0 to 26
$aUnitUsedValues[$num] = '[' & $aUnitUsedValues[$num] & ']'
next

[/autoit] [autoit][/autoit] [autoit]

; gesetzte Werte löschen
For $cell = 0 To 80

[/autoit] [autoit][/autoit] [autoit]

If StringLen($aSudoku[$cell]) = 1 Then continueLoop

[/autoit] [autoit][/autoit] [autoit]

_getCellDetails($cell, $row, $col, $box)

[/autoit] [autoit][/autoit] [autoit]

$aSudoku[$cell] = StringRegExpReplace($aSudoku[$cell], $aUnitUsedValues[$row], "")
$aSudoku[$cell] = StringRegExpReplace($aSudoku[$cell], $aUnitUsedValues[$col+9], "")
$aSudoku[$cell] = StringRegExpReplace($aSudoku[$cell], $aUnitUsedValues[$box+18], "")

[/autoit] [autoit][/autoit] [autoit]

; Zellen mit nur einem Wert merken
If StringLen($aSudoku[$cell]) = 1 Then
_appendCellToString($cell, $sSingles) ; Zelle 2-stellig + ;
EndIf

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_prepare

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Anzahl Zellen pro Wert in einer Unit
; $aUnitFreq[3][9][9] ; 3 UnitArt (Row, Col, Box), 9 Units, max. 9 Werte
func _getUnitFrequencies(byref $aUnitFreq, byref $aSudoku, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $cellNr, $cell
local $valueNr, $value
local $row, $col, $box

[/autoit] [autoit][/autoit] [autoit]

; offene Zellen pro Unit und Wert erfassen
for $cellNr = 1 to stringlen($sOpenCells) / 3
_getCellFromString($cell, $sOpenCells, $cellNr)
_getCellDetails($cell, $row, $col, $box)
for $valueNr = 1 to stringlen($aSudoku[$cell])
$value = stringmid($aSudoku[$cell], $valueNr, 1)
_appendCellToString($cell, $aUnitFreq[0][$row][$value - 1])
_appendCellToString($cell, $aUnitFreq[1][$col][$value - 1])
_appendCellToString($cell, $aUnitFreq[2][$box][$value - 1])
next
next

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; $aUnitOpen[3][9]; 3 UnitArt (Row, Col, Box), 9 Units, String mit Zellindizes
func _getOpenCellsPerUnit(byref $aUnitOpen, byref $sOpenCells)
local $cellNr
local $cell, $row, $col, $box

[/autoit] [autoit][/autoit] [autoit]

; offene Zellen durchgehen
for $cellNr = 1 to StringLen($sOpenCells) / 3
;~ $cell = stringmid($sOpenCells, ($cellNr - 1) * 3 + 1, 2)
_getCellFromString($cell, $sOpenCells, $cellnr)
_getCellDetails($cell, $row, $col, $box)
_appendCellToString($cell, $aUnitOpen[0][$row])
_appendCellToString($cell, $aUnitOpen[1][$col])
_appendCellToString($cell, $aUnitOpen[2][$box])
next
endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Werte verdichten
func _condenseValues(byref $values)
local $i, $value

[/autoit] [autoit][/autoit] [autoit]

for $i = 1 to 3
; Wert lesen
$value = stringmid($values, $i, 1)
; alle Vorkommen des Wertes löschen
$values = stringreplace($values, $value, "", 0, 2)
; Wert vorne wieder anfügen
$values = $value & $values
next
endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zellen verdichten
func _condenseCells(byref $cells)
local $i, $cell

[/autoit] [autoit][/autoit] [autoit]

for $i = 1 to 3
; Zelle lesen
_getCellFromString($cell, $cells, $i)
; alle Vorkommen der Zelle löschen
_removeCellFromString($cell, $cells)
; Zelle vorne wieder einfügen
_insertCellIntoString($cell, $cells)
next
endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zellindizes mit Semikolon getrennt an String anhängen
Func _appendCellToString(ByRef $cell, ByRef $s)
$s &= StringFormat("%02d", $cell) & ';'
EndFunc ;==>_appendCellToString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zellindizes mit Semikolon getrennt an erster Stelle in String einfügen
Func _insertCellIntoString(ByRef $cell, ByRef $s)
$s = StringFormat("%02d", $cell) & ';' & $s
EndFunc ;==>_appendCellToString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zelle an erster Stelle entfernen; $cell ist leer, wenn Strin leer
Func _popCellFromString(ByRef $cell, ByRef $s, $removeAll = False)
$cell = StringLeft($s, 2)
If $removeAll Then
_removeCellFromString($cell, $s)
Else
$s = StringMid($s, 4)
EndIf
EndFunc ;==>_popCellFromString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Index von 1 bis AnzahlZellen
func _getCellFromString(byref $cell, byref $s, byref $index)
$cell = stringmid($s, ($index - 1) * 3 + 1, 2)
endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zellindex aus String komplett entfernen
Func _removeCellFromString(ByRef $cell, ByRef $s)
$s = StringReplace($s, string($cell) & ';', "")
EndFunc ;==>_removeCellFromString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Wert aus String entfernen
Func _removeValueFromString(ByRef $value, ByRef $s)
$s = StringReplace($s, string($value), "", 1, 2)
return @extended
EndFunc ;==>_removeValueFromString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Prüfen, ob eine Zelle im String vorhanden ist
Func _cellExistsInString(ByRef $cell, ByRef $s)
Return StringInStr($s, StringFormat("%02d", $cell), 2)
EndFunc ;==>_cellExistsInString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Wert aus den angegebenen Units löschen
Func _deleteValueFromUnits(ByRef $startCell, ByRef $value, ByRef $sDelCells, byref $aSudoku, byref $sSingles, $getDelCells = false)

[/autoit] [autoit][/autoit] [autoit]

Local $row, $col, $box
local $row2, $col2, $box2
local $colID, $rowID, $boxID
local $cell
local $count
local $ret

[/autoit] [autoit][/autoit] [autoit]

_getCellDetails($startCell, $row, $col, $box)

[/autoit] [autoit][/autoit] [autoit]

; Zeile durchlaufen
For $colID = 0 To 8
_cellOfRowCol($row, $colID, $cell)
if $cell = $startCell then continueLoop
$ret = _deleteValueFromCell($value, $aSudoku, $cell, $sSingles)
if $ret = -1 then
return -1 ; Fehler
elseif $ret > 0 then
$count += $ret
if $getDelCells then _appendCellToString($cell, $sDelCells)
endif
Next

[/autoit] [autoit][/autoit] [autoit]

; Spalte durchlaufen
for $rowID = 0 to 8
_cellOfRowCol($rowID, $col, $cell)
if $cell = $startCell then continueLoop
$ret = _deleteValueFromCell($value, $aSudoku, $cell, $sSingles)
if $ret = -1 then
return -1 ; Fehler
elseif $ret > 0 then
$count += $ret
if $getDelCells then _appendCellToString($cell, $sDelCells)
endif
next

[/autoit] [autoit][/autoit] [autoit]

; Boxzellen durchlaufen (abgearbeitete Zellen doppelt ist schneller)
for $boxID = 0 to 8
_cellOfBoxAndIndex($box, $boxID, $cell)
if $cell = $startCell then continueLoop

[/autoit] [autoit][/autoit] [autoit]

$ret = _deleteValueFromCell($value, $aSudoku, $cell, $sSingles)
if $ret = -1 then
return -1 ; Fehler
elseif $ret > 0 then
$count += $ret
if $getDelCells then _appendCellToString($cell, $sDelCells)
endif
next

[/autoit] [autoit][/autoit] [autoit]

return 0

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_deleteValueFromUnits

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Wert aus Zelle löschen und ggf. an Einer-Queue anhängen, wenn nur noch ein Wert übrig ist
func _deleteValueFromCell(byref $value, byref $aSudoku, byref $cell, byref $sSingles)

[/autoit] [autoit][/autoit] [autoit]

local $len
local $count

[/autoit] [autoit][/autoit] [autoit]

; Zelle darf noch nicht erledigt sein
$len = StringLen($aSudoku[$cell])
If $len > 1 Then
; Wert rauslöschen
$count = _removeValueFromString($value, $aSudoku[$cell])
; Wert ersetzt?
If $count > 0 Then
; evtl zu Einerzellen hinzufügen (Länge vor dem Löschen = 2)
If $len = 2 Then
_appendCellToString($cell, $sSingles)
EndIf
EndIf

[/autoit] [autoit][/autoit] [autoit]

return $count

[/autoit] [autoit][/autoit] [autoit]

; prüfen, ob ein Wert doppelt vorkommt
elseif $aSudoku[$cell] = $value then
return -1
EndIf

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;********************************************** Strategien *********************************************

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Einzelwerte
; diese stehen nach _prepare schon in der Sudoku-Matrix, aber der Wert steht auch noch
; in den anderen Zellen der Unit, aus denen sie elimiert werden müssen
Func _Singles(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $sStartCells, $sDelCells
local $count = 0
Local $value
Local $cell
local $ret

[/autoit] [autoit][/autoit] [autoit]

; gibt es Einzelwerte?
While $sSingles <> ""

[/autoit] [autoit][/autoit] [autoit]

_popCellFromString($cell, $sSingles)
_removeCellFromString($cell, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

$value = $aSudoku[$cell]
if $value = "" then return -1

[/autoit] [autoit][/autoit] [autoit]

$ret = _deleteValueFromUnits($cell, $value, $sDelCells, $aSudoku, $sSingles, $output)

[/autoit] [autoit][/autoit] [autoit]

if $ret = -1 then return -1

[/autoit] [autoit][/autoit] [autoit]

if $output then
_appendCellToString($cell, $sStartCells)
_outputHeading($hdlFile, "Singles")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
$sStartCells = ""
$sDelCells = ""
endif

[/autoit] [autoit][/autoit] [autoit]

$count += 1

[/autoit] [autoit][/autoit] [autoit]

WEnd

[/autoit] [autoit][/autoit] [autoit]

; Anzahl zurückgeben
Return $count

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_Singles

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Naked Doubles
; 2 Zellen mit zwei gleichen Werten
Func _Doubles(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $found = 0
local $deleted
local $count
local $i
local $value ;, $values
local $lowerValues, $upperValues
local $cellCount
local $cellNr
local $cell
local $unit, $unitNr
local $aUnitOpenCells[3][9] ; 3 UnitArt (Row, Col, Box), 9 Units, Zellen
local $sTestCells
local $lower, $upper
local $lowerCell, $upperCell
local $sStartCells, $sDelCells
local $sUnitCells

[/autoit] [autoit][/autoit] [autoit]

_getOpenCellsPerUnit($aUnitOpenCells, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

for $unit = 0 to 2

[/autoit] [autoit][/autoit] [autoit]

for $unitNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; wenn es nur 2 offene Zellen gibt, ist die Analyse sinnlos, weil nichts zu entfernen wäre
$cellCount = stringlen($aUnitOpenCells[$unit][$unitNr]) / 3
if $cellCount <= 2 then ContinueLoop

[/autoit] [autoit][/autoit] [autoit]

; Zellen mit 2 Werten ermitteln => $sTestCells
$sTestCells = ""
For $cellNr = 1 to $cellCount
_getCellFromString($cell, $aUnitOpenCells[$unit][$unitNr], $cellNr)
; 2 Werte
if stringlen($aSudoku[$cell]) = 2 then
_appendCellToString($cell, $sTestCells)
endif
next

[/autoit] [autoit][/autoit] [autoit]

; jede 2er Zelle mit jeder anderen 2er Zelle
; untere Grenze vom Start nach oben verschieben
$cellCount = stringlen($sTestCells) / 3
if $cellCount < 2 then continueLoop

[/autoit] [autoit][/autoit] [autoit]

for $lower = 1 to $cellCount - 1
_getCellFromString($lowerCell, $sTestCells, $lower)

[/autoit] [autoit][/autoit] [autoit]

; obere Grenze von der 3. Zelle aus nach oben verschieben
for $upper = $lower + 1 to $cellcount

[/autoit] [autoit][/autoit] [autoit]

_getCellFromString($upperCell, $sTestCells, $upper)

[/autoit] [autoit][/autoit] [autoit]

$lowerValues = $aSudoku[$lowerCell]
$upperValues = $aSudoku[$upperCell]

[/autoit] [autoit][/autoit] [autoit]

; 2 Zellen mit den gleichen zwei Werten
if $lowerValues = $upperValues then

[/autoit] [autoit][/autoit] [autoit]

; diese 2 Werte aus den weiteren Zellen dieser Unit entfernen
$sUnitCells = $aUnitOpenCells[$unit][$unitNr]
_popCellFromString($cell, $sUnitCells)
$deleted = false

[/autoit] [autoit][/autoit] [autoit]

while $cell <> ""
; Ausgangszellen überspringen
if $cell <> $lowerCell and $cell <> $upperCell then
; alle 2 Werte aus anderen Zellen eliminieren
for $i = 1 to 2
$value = StringMid($lowerValues, $i, 1)
$count = _removeValueFromString($value, $aSudoku[$cell])
; Fehler?
if $aSudoku[$cell] = "" then return -1
; Wert wurde gelöscht
if $count > 0 then
_appendCellToString($cell, $sDelCells)
$deleted = true
if StringLen($aSudoku[$cell]) = 1 then
_appendCellToString($cell, $sSingles)
endif
endif
next
endif
_popCellFromString($cell, $sUnitCells)
wend

[/autoit] [autoit][/autoit] [autoit]

if $deleted then $found += 1 ; nur hochzählen, wenn gelöscht wurde

[/autoit] [autoit][/autoit] [autoit]

if $output and $deleted then
_appendCellToString($lowerCell, $sStartCells)
_appendCellToString($upperCell, $sStartCells)
_outputHeading($hdlFile, "Naked Doubles")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
$sStartCells = ""
$sDelCells = ""
endif

[/autoit] [autoit][/autoit] [autoit]

endif

[/autoit] [autoit][/autoit] [autoit]

next ; obere Zelle

[/autoit] [autoit][/autoit] [autoit]

next ; untere Zelle

[/autoit] [autoit][/autoit] [autoit]

next ; UnitNr

[/autoit] [autoit][/autoit] [autoit]

next ; UnitArt

[/autoit] [autoit][/autoit] [autoit]

return $found

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_Doubles

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Naked Triples
; 3er Kombinationen z. b. bei 5: 1, 2, 3; 1, 2, 4 1, 3, 4; 1, 2, 5 1, 3, 5, 1, 4, 5;
; 2, 3, 4; 2, 3, 5 2, 4, 5; 3, 4, 5;
Func _Triples(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $found = 0
local $deleted
local $count
local $i
local $value, $values
local $cellCount
local $cellNr
local $cell
local $unit, $unitNr
local $aUnitOpenCells[3][9] ; 3 UnitArt (Row, Col, Box), 9 Units, Zellen
local $sTestCells
local $lower, $upper, $mid
local $lowerCell, $upperCell, $midCell
local $sStartCells, $sDelCells
local $sUnitCells

[/autoit] [autoit][/autoit] [autoit]

_getOpenCellsPerUnit($aUnitOpenCells, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

for $unit = 0 to 2

[/autoit] [autoit][/autoit] [autoit]

for $unitNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; wenn es nur 3 offene Zellen, gibt ist die Analyse sinnlos, weil nichts zu entfernen wäre
$cellCount = stringlen($aUnitOpenCells[$unit][$unitNr]) / 3
if $cellCount <= 3 then ContinueLoop

[/autoit] [autoit][/autoit] [autoit]

; Zellen mit 2 oder 3 Werte ermitteln => $sTestCells
$sTestCells = ""
For $cellNr = 1 to $cellCount
;~ $cell = stringmid($aUnitOpenCells[$unit][$unitNr], ($cellNr - 1) * 3 + 1, 2)
_getCellFromString($cell, $aUnitOpenCells[$unit][$unitNr], $cellNr)
; 2 oder 3 Werte
if stringlen($aSudoku[$cell]) = 2 or stringlen($aSudoku[$cell]) = 3 then
_appendCellToString($cell, $sTestCells)
endif
next

[/autoit] [autoit][/autoit] [autoit]

; jede 2er/3er Zelle mit jeder anderen 2er/3er Zelle
; untere Grenze vom Start nach oben verschieben
$cellCount = stringlen($sTestCells) / 3

[/autoit] [autoit][/autoit] [autoit]

for $lower = 1 to $cellCount - 2
_getCellFromString($lowerCell, $sTestCells, $lower)
; obere Grenze von der 3. Zelle aus nach oben verschieben
for $upper = 3 to $cellcount
_getCellFromString($upperCell, $sTestCells, $upper)
; Mitte zwischen unterer und oberer Zelle verschieben
for $mid = $lower + 1 to $upper -1
_getCellFromString($midCell, $sTestCells, $mid)
$values = $aSudoku[$lowerCell]
$values &= $aSudoku[$midCell]
$values &= $aSudoku[$upperCell]
_condenseValues($values)
; genau 3 Werte bleiben übrig
if stringlen($values) = 3 then

[/autoit] [autoit][/autoit] [autoit]

; diese 3 Werte aus den weiteren Zellen dieser Unit entfernen
$sUnitCells = $aUnitOpenCells[$unit][$unitNr]
_popCellFromString($cell, $sUnitCells)
$deleted = false

[/autoit] [autoit][/autoit] [autoit]

while $cell <> ""
; Ausgangszellen überspringen
if $cell <> $lowerCell and $cell <> $midCell and $cell <> $upperCell then
; alle 3 Werte aus anderen Zellen eliminieren
for $i = 1 to 3
$value = StringMid($values, $i, 1)
$count = _removeValueFromString($value, $aSudoku[$cell])
; Fehler?
if $aSudoku[$cell] = "" then return -1
; Wert wurde gelöscht
if $count > 0 then
_appendCellToString($cell, $sDelCells)
$deleted = true
if StringLen($aSudoku[$cell]) = 1 then
_appendCellToString($cell, $sSingles)
endif
endif
next
endif
_popCellFromString($cell, $sUnitCells)
wend

[/autoit] [autoit][/autoit] [autoit]

if $deleted then $found += 1 ; nur hochzählen, wenn gelöscht wurde

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

if $output and $deleted then
_appendCellToString($lowerCell, $sStartCells)
_appendCellToString($midCell, $sStartCells)
_appendCellToString($upperCell, $sStartCells)
_outputHeading($hdlFile, "Naked Triples")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
$sStartCells = ""
$sDelCells = ""
endif

[/autoit] [autoit][/autoit] [autoit]

endif

[/autoit] [autoit][/autoit] [autoit]

next ; mittlere Zelle

[/autoit] [autoit][/autoit] [autoit]

next ; obere Zelle

[/autoit] [autoit][/autoit] [autoit]

next ; untere Zelle

[/autoit] [autoit][/autoit] [autoit]

next ; UnitNr

[/autoit] [autoit][/autoit] [autoit]

next ; UnitArt

[/autoit] [autoit][/autoit] [autoit]

return $found

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_Doubles

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Es gibt einen Wert, der nur in genau einer Zelle einer Unit vorkommt
Func _HiddenSingles(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $sStartCells, $sDelCells
local $cellNr, $cell
local $value
local $row, $col, $box
local $unitNr
local $count = 0
local $ret
local $aUnitFreq[27]

[/autoit] [autoit][/autoit] [autoit]

; offene Zellen pro Unit und Wert erfassen
for $cellNr = 1 to stringlen($sOpenCells) / 3

[/autoit] [autoit][/autoit] [autoit]

_getCellFromString($cell, $sOpenCells, $cellNr)
_getCellDetails($cell, $row, $col, $box)

[/autoit] [autoit][/autoit] [autoit]

; offene Werte pro Unit aneinanderklatschen
$aUnitFreq[$row] &= $aSudoku[$cell]
$aUnitFreq[$col+9] &= $aSudoku[$cell]
$aUnitFreq[$box+18] &= $aSudoku[$cell]

[/autoit] [autoit][/autoit] [autoit]

; 1er-Werte pro Unit suchen
for $unitNr = 0 to 26

[/autoit] [autoit][/autoit] [autoit]

for $value = 1 to 9

[/autoit] [autoit][/autoit] [autoit]

; Wert muss zumindest vorhanden sein
if stringinstr($aUnitFreq[$unitNr], string($value), 2) = 0 then continueloop
; Wert darf nicht ein 2. Mal vorkommen
if stringinstr($aUnitFreq[$unitNr], string($value), 2, 2) > 0 then continueloop

[/autoit] [autoit][/autoit] [autoit]

; welche Zelle enthält den Wert nur einmal?
for $cellNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; Zelle zu Unit und Index ermitteln
_cellOfUnitAndIndex($unitNr, $cellNr, $cell)

[/autoit] [autoit][/autoit] [autoit]

; Wert in dieser Zelle?
if Stringinstr($aSudoku[$cell], string($value), 2) then

[/autoit] [autoit][/autoit] [autoit]

$sDelCells = ""

[/autoit] [autoit][/autoit] [autoit]

; Single direkt verarbeiten
$aSudoku[$cell] = $value ; nur noch diesen Wert übrig lassen
_removeCellFromString($cell, $sOpenCells)
$ret = _deleteValueFromUnits($cell, $value, $sDelCells, $aSudoku, $sSingles, $output)

[/autoit] [autoit][/autoit] [autoit]

if $ret = -1 then return -1 ; Fehler
if $sSingles <> "" then return $count ; Single vorhanden

[/autoit] [autoit][/autoit] [autoit]

; Ausgabe
if $output then
$sStartCells = ""
_appendCellToString($cell, $sStartCells)
_outputHeading($hdlFile, "Hidden Singles")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
endif

[/autoit] [autoit][/autoit] [autoit]

exitloop

[/autoit] [autoit][/autoit] [autoit]

endif

[/autoit] [autoit][/autoit] [autoit]

$count += 1

[/autoit] [autoit][/autoit] [autoit]

next ; $value = 1 to 9

[/autoit] [autoit][/autoit] [autoit]

next ; $unitNr = 0 to 26

[/autoit] [autoit][/autoit] [autoit]

return $count

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; HiddenDoubles: es gibt zwei Werte, die nur in zwei Zellen vorkommen
func _HiddenDoubles(byref $output, byref $hdlFile, byref $aSudoku, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $found = 0
local $deleted
local $sStartCells, $sDelCells
local $cell, $cells
local $value, $values
local $sTestValues
local $cellCount, $valueCount
local $unit, $unitNr
local $lower, $upper
local $lowerValue, $upperValue
local $aUnitFreq[3][9][9] ; 3 UnitArt (Row, Col, Box), 9 Units, max. 9 Werte

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

_getUnitFrequencies($aUnitFreq, $aSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

for $unit = 0 to 2

[/autoit] [autoit][/autoit] [autoit]

for $unitNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; Werte mit 2 Zellen ermitteln
$sTestValues = ""
for $value = 1 to 9
$cellCount = StringLen($aUnitFreq[$unit][$unitNr][$value - 1]) / 3
if $cellCount = 2 then
$sTestValues &= $value
endif
next

[/autoit] [autoit][/autoit] [autoit]

; Analyse lohnt nur, wenn es noch mehr als 2 offene Werte gibt
$valueCount = StringLen($sTestValues)
if $valueCount <= 2 then ContinueLoop

[/autoit] [autoit][/autoit] [autoit]

; Strategie lohnt nur, wenn die betroffenen Zellen mehr, als die 2 Werte enthalten

[/autoit] [autoit][/autoit] [autoit]

; jeden 2er Wert mit jedem anderen 2er Wert kombinieren
; untere Grenze vom Start nach oben verschieben
for $lower = 1 to $valueCount - 1

[/autoit] [autoit][/autoit] [autoit]

; obere Grenze von der 3. Zelle aus nach oben verschieben
for $upper = $lower to $valueCount

[/autoit] [autoit][/autoit] [autoit]

; betroffene Werte
$lowerValue = StringMid($sTestValues, $lower, 1)
$upperValue = StringMid($sTestValues, $upper, 1)

[/autoit] [autoit][/autoit] [autoit]

; zugehörige Zellen hintereinander in einen String
$cells = $aUnitFreq[$unit][$unitNr][$lowerValue - 1]
$cells &= $aUnitFreq[$unit][$unitNr][$upperValue - 1]

[/autoit] [autoit][/autoit] [autoit]

; Zellen verdichten
_condenseCells($cells)

[/autoit] [autoit][/autoit] [autoit]

; genau drei gefunden
if StringLen($cells) / 3 = 2 then

[/autoit] [autoit][/autoit] [autoit]

$sStartCells = ""
$sDelCells = ""

[/autoit] [autoit][/autoit] [autoit]

; auszuschließende Werte
$values = "[^" & $lowerValue & $upperValue & "]"
$deleted = false

[/autoit] [autoit][/autoit] [autoit]

; übrige Werte löschen
for $i = 1 to 2
_popCellFromString($cell, $cells)
; alles außer den 2 Werten löschen
$aSudoku[$cell] = StringRegExpReplace($aSudoku[$cell], $values, "")

[/autoit] [autoit][/autoit] [autoit]

; Fehler?
if $aSudoku[$cell] = "" then return -1

[/autoit] [autoit][/autoit] [autoit]

if $output then
; wurde was gelöscht?
if @extended > 0 then
$deleted = true
_appendCellToString($cell, $sDelCells)
endif
_appendCellToString($cell, $sStartCells)
endif

[/autoit] [autoit][/autoit] [autoit]

if $deleted then $found += 1

[/autoit] [autoit][/autoit] [autoit]

if $output and $deleted then
_outputHeading($hdlFile, "Hidden Doubles")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
endif

[/autoit] [autoit][/autoit] [autoit]

endif ; genau 2 Zellen gefunden

[/autoit] [autoit][/autoit] [autoit]

next ; obere Grenze verschieben

[/autoit] [autoit][/autoit] [autoit]

next ; untere Grenze verschieben

[/autoit] [autoit][/autoit] [autoit]

next ; UnitNr

[/autoit] [autoit][/autoit] [autoit]

next ; UnitArt

[/autoit] [autoit][/autoit] [autoit]

return $found

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; HiddenTriple: es gibt drei Werte, die in genau 3 Zellen (verdichtet) liegen
func _HiddenTriples(byref $output, byref $hdlFile, byref $aSudoku, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $found = 0
local $deleted
local $sStartCells, $sDelCells
local $cell, $cells
local $value, $values
local $sTestValues
local $cellCount, $valueCount
local $unit, $unitNr
local $lower, $upper, $mid
local $lowerValue, $upperValue, $midValue
local $aUnitFreq[3][9][9] ; 3 UnitArt (Row, Col, Box), 9 Units, max. 9 Werte

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

_getUnitFrequencies($aUnitFreq, $aSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

for $unit = 0 to 2

[/autoit] [autoit][/autoit] [autoit]

for $unitNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; Werte mit 2 oder 3 Zellen ermitteln
$sTestValues = ""
for $value = 1 to 9
$cellCount = StringLen($aUnitFreq[$unit][$unitNr][$value - 1]) / 3
if $cellCount = 2 or $cellCount = 3 then
$sTestValues &= $value
endif
next

[/autoit] [autoit][/autoit] [autoit]

; Analyse lohnt nur, wenn es noch mehr als 3 offene Werte gibt
$valueCount = StringLen($sTestValues)
if $valueCount <= 3 then ContinueLoop

[/autoit] [autoit][/autoit] [autoit]

; Strategie lohnt nur, wenn die betroffenen Zellen mehr, als die 2 oder 3 Werte enthalten

[/autoit] [autoit][/autoit] [autoit]

; jeden 2er/3er Wert mit jedem anderen 2er/3er Wert kombinieren
; untere Grenze vom Start nach oben verschieben
for $lower = 1 to $valueCount - 2

[/autoit] [autoit][/autoit] [autoit]

; obere Grenze von der 3. Zelle aus nach oben verschieben
for $upper = 3 to $valueCount

[/autoit] [autoit][/autoit] [autoit]

; Mitte zwischen unterer und oberer Zelle verschieben
for $mid = $lower + 1 to $upper -1

[/autoit] [autoit][/autoit] [autoit]

; betroffene Werte
$lowerValue = StringMid($sTestValues, $lower, 1)
$midValue = StringMid($sTestValues, $mid, 1)
$upperValue = StringMid($sTestValues, $upper, 1)

[/autoit] [autoit][/autoit] [autoit]

; zugehörige Zellen hintereinander in einen String
$cells = $aUnitFreq[$unit][$unitNr][$lowerValue - 1]
$cells &= $aUnitFreq[$unit][$unitNr][$midValue - 1]
$cells &= $aUnitFreq[$unit][$unitNr][$upperValue - 1]

[/autoit] [autoit][/autoit] [autoit]

; Zellen verdichten
_condenseCells($cells)

[/autoit] [autoit][/autoit] [autoit]

; genau drei gefunden
if StringLen($cells) / 3 = 3 then

[/autoit] [autoit][/autoit] [autoit]

$sStartCells = ""
$sDelCells = ""

[/autoit] [autoit][/autoit] [autoit]

; auszuschließende Werte
$values = "[^" & $lowerValue & $midValue & $upperValue & "]"
$deleted = false

[/autoit] [autoit][/autoit] [autoit]

; übrige Werte löschen
for $i = 1 to 3
_popCellFromString($cell, $cells)
; alles außer den 3 Werten löschen
$aSudoku[$cell] = StringRegExpReplace($aSudoku[$cell], $values, "")

[/autoit] [autoit][/autoit] [autoit]

; Fehler?
if $aSudoku[$cell] = "" then return -1

[/autoit] [autoit][/autoit] [autoit]

if $output then
; wurde was gelöscht?
if @extended > 0 then
$deleted = true
;~ $found += 1
_appendCellToString($cell, $sDelCells)
endif
_appendCellToString($cell, $sStartCells)
endif

[/autoit] [autoit][/autoit] [autoit]

if $deleted then $found += 1

[/autoit] [autoit][/autoit] [autoit]

if $output and $deleted then
_outputHeading($hdlFile, "Hidden Triples")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
endif

[/autoit] [autoit][/autoit] [autoit]

endif ; genau 3 Zellen gefunden

[/autoit] [autoit][/autoit] [autoit]

next ; Mitte zwischen unterer und oberer Grenze verschieben

[/autoit] [autoit][/autoit] [autoit]

next ; obere Grenze verschieben

[/autoit] [autoit][/autoit] [autoit]

next ; untere Grenze verschieben

[/autoit] [autoit][/autoit] [autoit]

next ; UnitNr

[/autoit] [autoit][/autoit] [autoit]

next ; UnitArt

[/autoit] [autoit][/autoit] [autoit]

return $found

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Pointing Pairs / Box-Line-Reduction
; ein Wert der 2-3 mal in einer Unit vorkommt und bereits eindeutig ist, sodass sicher ist, dass der Wert in dieser Unit liegen muss
; Zusätzlich liegen die Vorkommen des Wertes in einer anderen Unit, aus der dieser eliminiert werden kann
Func _PP_BL_Reduction(byref $output, byref $hdlFile, byref $aSudoku, byref $sSingles, byref $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

local $unit, $unitNr
local $value
local $cellCount
local $sTestValues
local $aUnitFreq[3][9][9] ; 3 UnitArt (Row, Col, Box), 9 Units, max. 9 Werte
Local $valueCellUnits[3][3]
local $durchlauf
local $cell, $partnerCell
local $partnerCellCount
local $partnerUnit, $partnerUnitNr
local $row, $col, $box
local $deleted
local $sDelCells, $sStartCells

[/autoit] [autoit][/autoit] [autoit]

_getUnitFrequencies($aUnitFreq, $aSudoku, $sOpenCells)

[/autoit] [autoit][/autoit] [autoit]

for $unit = 0 to 2

[/autoit] [autoit][/autoit] [autoit]

for $unitNr = 0 to 8

[/autoit] [autoit][/autoit] [autoit]

; Werte mit 2 oder 3 Zellen ermitteln
for $value = 1 to 9

[/autoit] [autoit][/autoit] [autoit]

$cellCount = StringLen($aUnitFreq[$unit][$unitNr][$value - 1]) / 3
if $cellCount = 2 or $cellCount = 3 then

[/autoit] [autoit][/autoit] [autoit]

; Units der 2 bzw. 3 Wertezellen sammeln
$durchlauf = 0
For $cellNr = 1 to $cellCount
_getCellFromString($cell, $aUnitFreq[$unit][$unitNr][$value - 1], $cellNr)
_getCellDetails($cell, $valueCellUnits[$durchlauf][0], $valueCellUnits[$durchlauf][1], $valueCellUnits[$durchlauf][2])
$durchlauf += 1
Next

[/autoit] [autoit][/autoit] [autoit]

; Units auf Gleichheitswerte verdichten
Dim $sameUnits[3] = [True, True, True]
For $durchlauf = 1 To $cellCount - 1
For $i = 0 To 2
; jeweils Unit mit Unit der Vorgängerzelle vergleichen
If $valueCellUnits[$durchlauf][$i] <> $valueCellUnits[$durchlauf - 1][$i] Then
$sameUnits[$i] = False
EndIf
Next
Next

[/autoit] [autoit][/autoit] [autoit]

; gibt es eine weitere gemeinsame Unit?
$partnerUnit = -1
For $i = 0 To 2
; aktuelle Unit vom Vergleich ausnehmen
If $i = $unit Then ContinueLoop

[/autoit] [autoit][/autoit] [autoit]

If $sameUnits[$i] Then
$partnerUnit = $i ; Unit: Zeile, Spalte, Box
$partnerUnitNr = $valueCellUnits[0][$i] ; x-te Unit
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

; gibt es in der weiteren gemeinsamen Unit noch Werte die gelöscht werden können?
If $partnerUnit <> -1 Then

[/autoit] [autoit][/autoit] [autoit]

$partnerCellCount = StringLen($aUnitFreq[$partnerUnit][$partnerUnitNr][$value - 1]) / 3
for $i = 1 to $partnerCellCount
_getCellFromString($partnerCell, $aUnitFreq[$partnerUnit][$partnerUnitNr][$value - 1], $i)
_getCellDetails($partnerCell, $row, $col, $box)
; nicht die Werte in der Start-Unit löschen!
if $unit = 0 and $unitNr = $row or _
$unit = 1 and $unitNr = $col or _
$unit = 2 and $unitNr = $box then
else
; Wert aus Zelle löschen
$deleted = _deleteValueFromCell($value, $aSudoku, $partnerCell, $sSingles)
if $output then _appendCellToString($partnerCell, $sDelCells)
EndIf
Next

[/autoit] [autoit][/autoit] [autoit]

if $output then
$sStartCells = $aUnitFreq[$unit][$unitNr][$value - 1]
_outputHeading($hdlFile, "Pointing Pairs / BL-Reduction")
_outputTable($hdlFile, $aSudoku, $sOpenCells, True, $sStartCells, $sDelCells)
endif

[/autoit] [autoit][/autoit] [autoit]

Return 0

[/autoit] [autoit][/autoit] [autoit]

EndIf ; Partnerunit wurde gefunden

[/autoit] [autoit][/autoit] [autoit]

endif
next

[/autoit] [autoit][/autoit] [autoit]

next ; UnitNr

[/autoit] [autoit][/autoit] [autoit]

next ; UnitArt

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_PointingPairs

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Y-Wing
; Von einer 2er Zelle A (Werte XY) ausgehend müssen zwei weitere 2er Zellen (B und C) in gemeinsamen Units gefunden werden,
; die die Werte XZ und YZ enthalten. Im Schnittbereich von B und C kann der Wert Z gelöscht werden

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Wert in einzelnen Zellen erraten und dann mit logischen Strategien weitermachen
; Bei Fehler, einen Schritt zurück und den nächsten Wert raten
func _BackTrack(byref $output, byref $hdlFile, byref $aSudoku, $sSingles, $sOpenCells, $btCount)

[/autoit] [autoit][/autoit] [autoit]

local $sStartCells
local $value, $values
local $cell, $sCells
local $cellCount
local $i, $j, $len
local $ret
local $id = 1
local $row, $col, $box
; Stand zwischenspeichern
local $aTestSudoku, $sTestOpenCells, $sTestSingles
;~ local $aCellCount[10]
local $aUnitValues[3][9]
local $minUnit, $minUnitNr, $minValueLen

[/autoit] [autoit][/autoit] [autoit]

$btCount += 1

[/autoit] [autoit][/autoit] [autoit]

; Werte pro Unit
for $cellCount = 1 to Stringlen($sOpenCells) / 3
_getCellFromString($cell, $sOpenCells, $cellCount)
_getCellDetails($cell, $row, $col, $box)
$aUnitValues[0][$row] &= $aSudoku[$cell]
$aUnitValues[1][$col] &= $aSudoku[$cell]
$aUnitValues[2][$box] &= $aSudoku[$cell]
next

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Unit mit möglichst wenigen Werten finden
$minValueLen = 10000
for $i = 0 to 2
for $j = 0 to 8
$len = StringLen($aUnitValues[$i][$j])
if $len < $minValueLen and $len > 0 then
$minValueLen = $len
$minUnit = $i
$minUnitNr = $j
endif
next
next

[/autoit] [autoit][/autoit] [autoit]

if $minUnit = 0 then
_cellsOfRow($minUnitNr, $sCells)
elseIf $minUnit = 1 then
_cellsOfCol($minUnitNr, $sCells)
elseIf $minUnit = 2 then
_cellsOfBox($minUnitNr, $sCells)
endif

[/autoit] [autoit][/autoit] [autoit]

; 1. offene Zelle nehmen
for $i = 1 to Stringlen($sCells) / 3
_getCellFromString($cell, $sCells, $i)
if _cellExistsInString($cell, $sOpenCells) then
exitloop
endif
next

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

$values = $aSudoku[$cell]

[/autoit] [autoit][/autoit] [autoit]

; einzelne Werte durchgehen
for $i = 1 to stringlen($values)

[/autoit] [autoit][/autoit] [autoit]

; so tun, als hätten wir eine gelöste Zelle gefunden
_appendCellToString($cell, $sSingles)
; Werte der Zelle der Reihe nach durchprobieren
$value = stringmid($values, $i, 1)

[/autoit] [autoit][/autoit] [autoit]

; aktuellen Stand zwischenspeichern
$aTestSudoku = $aSudoku
$sTestOpenCells = $sOpenCells
$sTestSingles = $sSingles

[/autoit] [autoit][/autoit] [autoit]

$aTestSudoku[$cell] = $value

[/autoit] [autoit][/autoit] [autoit]

if $__BT__ then
; Einrückung
for $j = 1 to $btCount
ConsoleWrite(" ")
next
consolewrite("BACKTRACKING Ebene: " & $btCount & "; probiere Wert " & $value & " in Zelle " & $cell & @crlf)
endif

[/autoit] [autoit][/autoit] [autoit]

if $output then

[/autoit] [autoit][/autoit] [autoit]

$sStartCells = ""
_appendCellToString($cell, $sStartCells)
_outputHeading($hdlFile, "Backtracking Ebene " & $btCount)
_outputTable($hdlFile, $aTestSudoku, $sTestOpenCells, True, $sStartCells, $sStartCells)
endif

[/autoit] [autoit][/autoit] [autoit]

$ret = _solve($output, $hdlFile, $aTestSudoku, $sTestSingles, $sTestOpenCells, $btCount)
; Sudoku gelöst
if $ret = 0 then
$aSudoku = $aTestSudoku
return 0
endif
next

[/autoit] [autoit][/autoit] [autoit]

return -1

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;********************************************** Zugriffsfunktionen ***************************************

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zelle -> Spalte
Func _rowOfCell(ByRef $cell, ByRef $result)
$result = Floor($cell / 9)
EndFunc ;==>_rowOfCell

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zelle -> Zeile
Func _colOfcell(ByRef $cell, ByRef $result)
$result = Mod($cell, 9)
EndFunc ;==>_colOfcell

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zelle -> Box
Func _boxOfCell(ByRef $cell, ByRef $result)
$result = Floor($cell / 27) * 3 + Floor(Mod($cell, 9) / 3)
EndFunc ;==>_boxOfCell

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zelle -> Zellindex innerhalb der Box
Func _boxIndexOfCell(ByRef $cell, ByRef $result)
$result = Mod(Floor($cell / 9) * 3 + Mod(Mod($cell, 9), 3), 9)
EndFunc ;==>_boxIndexOfCell

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zeile / Spalte -> Zelle
Func _cellOfRowCol(ByRef $row, ByRef $col, ByRef $result)
$result = $row * 9 + $col
EndFunc ;==>_cellOfRowCol

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Zeile, Spalte, Box zur Zelle
Func _getCellDetails(ByRef $cell, ByRef $row, ByRef $col, ByRef $box)
_boxOfCell($cell, $box)
_rowOfCell($cell, $row)
_colOfcell($cell, $col)
EndFunc ;==>_getCellDetails

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _cellsOfRow(ByRef $row, ByRef $sCells, $exclCol = -1)

[/autoit] [autoit][/autoit] [autoit]

Local $col, $cell

[/autoit] [autoit][/autoit] [autoit]

For $col = 0 To 8
if $col = $exclCol then continueloop
_cellOfRowCol($row, $col, $cell)
_appendCellToString($cell, $sCells)
Next

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_cellsOfRow

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _cellsOfCol(ByRef $col, ByRef $sCells, $exclRow = -1)

[/autoit] [autoit][/autoit] [autoit]

Local $row, $cell

[/autoit] [autoit][/autoit] [autoit]

For $row = 0 To 8
if $row = $exclRow then continueloop
_cellOfRowCol($row, $col, $cell)
_appendCellToString($cell, $sCells)
Next

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_cellsOfCol

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _cellOfBoxAndIndex(ByRef $box, ByRef $boxIndex, ByRef $result)

[/autoit] [autoit][/autoit] [autoit]

; boxindex von 0 bis 8
Local $start

[/autoit] [autoit][/autoit] [autoit]

_startOfBox($box, $start)
$result = $start + Floor($boxIndex / 3) * 9 + Mod($boxIndex, 3)

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_cellOfBoxAndIndex

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; jeweils 9 Units (Zeile, Spalte, Box), $index von 0 bis 8
func _cellOfUnitAndIndex(byref $unitNr, byref $index, byref $cell)

[/autoit] [autoit][/autoit] [autoit]

local $row, $col, $box

[/autoit] [autoit][/autoit] [autoit]

; Zeile
if $unitNr < 9 then
$row = $unitnr
_cellOfRowCol($row, $index, $cell)
; Box
elseif $unitNr > 17 then
$box = $unitnr - 18
_cellOfBoxAndIndex($box, $index, $cell)
; Spalte
else
$col = $unitnr - 9
_cellOfRowCol($index, $col, $cell)
endif

[/autoit] [autoit][/autoit] [autoit]

$cell = StringFormat("%02d", $cell)
endfunc

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _cellsOfBox(ByRef $box, ByRef $sCells, $exclRow = -1, $exclCol = -1)

[/autoit] [autoit][/autoit] [autoit]

Local $start, $row, $col, $cell

[/autoit] [autoit][/autoit] [autoit]

_startOfBox($box, $start)
For $row = 0 To 18 Step 9
if $row = $exclRow then continueloop
For $col = 0 To 2
if $col = $exclCol then continueloop
$cell = $start + $row + $col
_appendCellToString($cell, $sCells)
Next
Next

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_cellsOfBox

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _startOfBox(ByRef $box, ByRef $result)
$result = Floor($box / 3) * 27 + Mod($box, 3) * 3
EndFunc ;==>_startOfBox

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _getCommonUnits($cell1, $cell2, ByRef $addBoxCells, ByRef $addRowCells, ByRef $addColCells)

[/autoit] [autoit][/autoit] [autoit]

;~ ; gleiche Box?
;~ $addBoxCells = False
;~ If _boxOfCell($cell1) = _boxOfCell($cell2) Then
;~ $addBoxCells = True
;~ EndIf

[/autoit] [autoit][/autoit] [autoit]

;~ ; gleiche Zeile?
;~ $addRowCells = False
;~ If _rowOfCell($cell1) = _rowOfCell($cell2) Then
;~ $addRowCells = True
;~ EndIf

[/autoit] [autoit][/autoit] [autoit]

;~ $addColCells = False
;~ If _colOfcell($cell1) = _colOfcell($cell2) Then
;~ $addColCells = True
;~ EndIf

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_getCommonUnits

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;*********************************************** Ausgabe *************************************************

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; mögliche Zellwerte als String zurückgeben
Func _getPossibleValuesString(ByRef $values)

[/autoit] [autoit][/autoit] [autoit]

Local $i
Local $valueString

[/autoit] [autoit][/autoit] [autoit]

For $i = 1 To StringLen($values)
If $i > 1 Then
$valueString &= ', '
If Mod($i, 4) = 0 Then $valueString &= "<br/>"
EndIf
$valueString &= StringMid($values, $i, 1)
Next

[/autoit] [autoit][/autoit] [autoit]

Return $valueString

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_getPossibleValuesString

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Kopf
Func _outputStart(ByRef $hdlFile)

[/autoit] [autoit][/autoit] [autoit]

Local $cellSize = "60px"

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

$hdlFile = FileOpen(@ScriptDir & "\output_new.html", 2)

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "<html><head><title>SuDoku Solver</title>")

[/autoit] [autoit][/autoit] [autoit]

; Styledefinition
FileWriteLine($hdlFile, '<style type="text/css">')
FileWriteLine($hdlFile, 'table {table-layout: fixed; border: 3px solid black; border-collapse: collapse}')
FileWriteLine($hdlFile, 'tr {height: ' & $cellSize & '; }')
FileWriteLine($hdlFile, 'td {width : ' & $cellSize & '; text-align: center; font-family: arial; border: 1px solid black; }')
FileWriteLine($hdlFile, 'td.source { background: lightgray; }')
FileWriteLine($hdlFile, 'td.target { border: 3px solid darkred; }')
FileWriteLine($hdlFile, 'td.odd {background: #FFFFFF; }')
FileWriteLine($hdlFile, 'td.even {background: #FFFFC9; }')

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, 'span.start {font-weight: bold; font-size: x-large; }')
FileWriteLine($hdlFile, 'span.solution {font-weight: bold; font-size: x-large; color: darkred; }')
FileWriteLine($hdlFile, 'span.possibilities {font-size: small; color: gray; }')

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, '</style>')

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, '</head><body>')

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>outputStart

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Ende
Func _outputEnd($hdlFile)

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "</body>")
FileClose($hdlFile)

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_outputEnd

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; Überschrift
Func _outputHeading($hdlFile, $heading)

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "<br/>")
FileWriteLine($hdlFile, "<h2>" & $heading & "</h2>")

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_outputHeading

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

; als Tabelle ausgeben
Func _outputTable(byref $hdlFile, byref $aSudoku, byref $sOpenCells, _
$possibilities = False, $highlightSource = -1, $highlightTarget = -1)

[/autoit] [autoit][/autoit] [autoit]

Local $box
Local $cell
Local $row, $col
Local $values
Local $tdclass
Local $class

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "<table>")

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

For $row = 0 To 8
FileWriteLine($hdlFile, "<tr>")

[/autoit] [autoit][/autoit] [autoit]

For $col = 0 To 8

[/autoit] [autoit][/autoit] [autoit]

_cellOfRowCol($row, $col, $cell)
_boxOfCell($cell, $box)

[/autoit] [autoit][/autoit] [autoit]

$tdclass = "odd" ; gelb
If Mod($box, 2) = 0 Then
$tdclass = "even" ; weiß
EndIf

[/autoit] [autoit][/autoit] [autoit]

If _cellExistsInString($cell, $highlightSource) Then
$tdclass = "source"
EndIf

[/autoit] [autoit][/autoit] [autoit]

If _cellExistsInString($cell, $highlightTarget) Then
$tdclass &= " target"
EndIf

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, '<td class="' & $tdclass & '">')
FileWrite($hdlFile, "<span class='")

[/autoit] [autoit][/autoit] [autoit]

$values = $aSudoku[$cell]
If _cellExistsInString($cell, $sProblemCells) Then
$class = "start"
ElseIf $possibilities Then
If _cellExistsInString($cell, $sOpenCells) Then
$values = _getPossibleValuesString($values)
$class = "possibilities"
Else
$class = "solution"
EndIf
Else
$values = ""
EndIf

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, $class & "'>" & $values & "</span></td>")

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "</tr>")

[/autoit] [autoit][/autoit] [autoit]

FileWriteLine($hdlFile, "</table>")

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>_outputTable

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _printFreq(byref $aUnitFreq, $unit = -1, $nr = -1)

[/autoit] [autoit][/autoit] [autoit]

local $value, $count
Local $title[3] = ["Zeile", "Spalte", "Box"]
Local $allNumbers = False, $allUnits = False

[/autoit] [autoit][/autoit] [autoit]

If $unit = -1 Then
$unit = 0
$allUnits = True
EndIf

[/autoit] [autoit][/autoit] [autoit]

If $nr = -1 Then
$nr = 0
$allNumbers = True
EndIf

[/autoit] [autoit][/autoit] [autoit]

; UnitArten
While 1

[/autoit] [autoit][/autoit] [autoit]

; Units
While 1

[/autoit] [autoit][/autoit] [autoit]

ConsoleWrite($title[$unit] & ": " & $nr + 1 & @CRLF)

[/autoit] [autoit][/autoit] [autoit]

; Werte
For $value = 1 to 9
$count = StringLen($aUnitFreq[$unit][$nr][$value-1]) / 3
ConsoleWrite(" Wert: " & $value & " Anzahl: " & $count & " Zellen: " & $aUnitFreq[$unit][$nr][$value-1] & @CRLF)
Next

[/autoit] [autoit][/autoit] [autoit]

$nr += 1
If Not $allNumbers Or $nr > 8 Then
$nr = 0
ExitLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

WEnd

[/autoit] [autoit][/autoit] [autoit]

$unit += 1
If Not $allUnits Or $unit > 2 Then
$unit = 0
ExitLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

WEnd

[/autoit] [autoit][/autoit] [autoit]

EndFunc ;==>printFreq

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

func _printOpenCellsPerUnit(byref $aUnitOpenCells, $unit = -1, $nr = -1)
Local $title[3] = ["Zeile", "Spalte", "Box"]
Local $allNumbers = False, $allUnits = False

[/autoit] [autoit][/autoit] [autoit]

If $unit = -1 Then
$unit = 0
$allUnits = True
EndIf

[/autoit] [autoit][/autoit] [autoit]

If $nr = -1 Then
$nr = 0
$allNumbers = True
EndIf

[/autoit] [autoit][/autoit] [autoit]

ConsoleWrite("Offene Zellen pro Unit:" & @CRLF)

[/autoit] [autoit][/autoit] [autoit]

; UnitArten
While 1

[/autoit] [autoit][/autoit] [autoit]

; Units
While 1

[/autoit] [autoit][/autoit] [autoit]

ConsoleWrite($title[$unit] & ": " & $nr + 1 & " Zellen: " & $aUnitOpenCells[$unit][$nr] & @CRLF)

[/autoit] [autoit][/autoit] [autoit]

$nr += 1
If Not $allNumbers Or $nr > 8 Then
$nr = 0
ExitLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

wend

[/autoit] [autoit][/autoit] [autoit]

$unit += 1
If Not $allUnits Or $unit > 2 Then
$unit = 0
ExitLoop
EndIf

[/autoit] [autoit][/autoit] [autoit]

wend

[/autoit] [autoit][/autoit] [autoit]

endfunc

[/autoit]

So schnell auf den letzten Drücker.

Gruß BlackMail.

BlackMail

Tja,

wollte die Box-Line-Reduction bzw. Pointing Pairs noch zum Laufen bringen und herausfinden, in welcher Reihenfolge man die Strategien am besten durchlaufen lässt.
Muss ich morgen nochmal machen.

Gruß BlackMail.

**Andy**

Zitat

...und herausfinden, in welcher Reihenfolge man die Strategien am besten durchlaufen lässt.

da habe ich auch lange rumexperimentiert. Eigentlich gibts nur die Standard-Antwort:" Je nach Sudoku unterschiedlich!"
Aber idR sind die "schnellen" Strategien besser vorne und die langsamen (bei mir z.B. hidden triples) hinten.
Ich lasse die "Einer finden"-Strategien so lange durchlaufen (do/loop), bis nichts mehr gefunden bzw eliminiert werden kann, erst danach die naked pairs usw bis hin zu den hidden triples.

Jedenfalls gibt dein Solver ganz schön Gas, ich lasse den grade die ersten 5000 Sudokus lösen

ciao
Andy

**Andy**

Habe meinen Solver wieder etwas beschleunigt, durch geringe Änderungen in der BacktrackSTRATEGIE, nicht im eigentlichen Bruteforce-Algorithmus.

Die "verbratenen" Zeiten bei den Strategien gehen beim Lösen mehrerer Sudokus gegenüber den Backtrackzeiten völlig unter.
Es hat also m.E. keinen Sinn, z.B. bei der Strategie "HiddenTriple" 30 Millisekunden einzusparen um beim Backtracken dann MINUTEN zu brauchen.

Daher möchte ich die "Backtrack-Strategie" zur Diskussion stellen:
Reines Backtracken hat nur Sinn, wenn in endlicher Zeit die Lösung gefunden werden kann. Im Laufe dieses Threads und beim Lösen der Sudokus ist einigen auch klar geworden, dass es fürs Backtracken "gute" und "schlechte" (will heissen sehr lange für die Lösung brauchende) Sudokus gibt.
Um ein "schlechtes" Sudoku trotzdem schnell zu lösen, benutze ich folgendes Vorgehen, eine Kombination aus Logiklöser und klassischem Backtrack.

DO
Suchen des nächsten Feldes mit 2 Möglichkeiten, wenn dieses nicht existiert, suche Feld mit 3 Möglichkeiten.
Nimm eine dieser Möglichkeiten an und löse logisch.
- Bisher wie gehabt, aber ich habe festgestellt, dass auch die "schlechtesten" Sudokus sofort mittels "Logik" lösbar sind, wenn 5 zusätzliche richtige Felder in das Rätsel eingebaut werden. Also kann man IMMER nach 5 fehlgeschlagenen Versuchen aus dem Backtrack raus, d.h. wenn nach 5 zusätzlich gesetzten Feldern keine logische Lösung existiert, dann ist diese Kombination der 5 Möglichkeiten falsch
Wenn keine Lösung zu finden ist, dann versuche klassisches Backtrack, aber mit geringer Rekursionstiefe.
"Einfache" Sudokus sind in kürzester Zeit mittels klassischem Backtrack zu lösen, d.h. die Lösung wird schon nach relativ wenigen Rekursionen gefunden. In der Annahme, daß das zu lösende Sudoku mit den 5 zusätzlich gesetzten Felder "einfach" ist, wird das Backtracken auf 1000-2000 Rekursionen beschränkt!
LOOP solange, bis eine Lösung gefunden wurde, oder noch nicht 5 Felder gesetzt sind.

Man kann jetzt an vielen Sudokus ausprobieren, welche Änderungen schneller zur Lösung führen. Indem man an den Parametern Anzahl der Felder (5 oder 6 oder 7) oder der Rekursionstiefe beim Backtracken (1000 oder 2000-5000) dreht, bekommt man eine schnelle Lösung (oder garkeine) oder aber eine sichere Lösung nach längerer Zeit. Ich habe mir einige der "schlechten" Sudokus geschnappt und dann solange an den Parametern geschraubt, bis sie erstens gelöst waren und zweitens relativ schnell^^

Aber vielleicht hat ja einer von euch eine ganz andere Idee!?

BlackMail

Hallo,

ich mache in meinem Skript bereits eine Kombination aus Raten und logisch lösen.
Zuerst gehe ich alle 6 Strategien durch (mit Pointing Pairs 7, ist gestern Nacht noch fertig geworden). Bringen mich alle Strategien nicht weiter, dann schmeiße ich den Backtracker an.
Hier suche ich zuerst die Unit (Zeile, Spalte oder Box) die die wenigsten offenen Werte hat und suche mir eine Zelle daraus, mit der ich anfange. Ich rate nur einen Wert in einer Zelle. Danach mache ich mit der Single- und der HiddenSingle-Strategie weiter. Im Backtrack-Modus begrenze ich die Strategien also auf 2, weil ich nicht für jede zu ratende Zelle alle Strategien erfolglos durchlaufen wollte.
Allerdings ist es häufig so, dass man eine Zelle rät und dann mit den beiden logischen Strategien das Sudoku fast komplett lösen kann.

Was habt ihr denn sonst für Erkenntnisse gewonnen?

Meine erste Version hat voll auf Dictionary-Objekte gesetzt. So hatte ich alles sofort im Zugriff:

alle noch offenen Zellen
alle Zellen pro Unit
alle offenen Wert pro Unit ...

Bis ich dann gemerkt habe, dass der Aufbau dieser Verwaltungsstrukturen bereits satte 300 ms verschlingt.
Dann musste ich alles neu schreiben und habe auf Strings und Arrays gesetzt.
Über Bits habe ich auch nachgedacht, habe diesen Gedanken aber wieder verworfen, weil mir das Auswerten schwierig oder aufwändig schien.

Ansonsten habe ich festgestellt, dass bei einfachen Stringoperationen die StringInStr- oder StringReplace- schneller sind als die RegExp-Varianten.

Außerdem sind Arrays total langsam. Mehrdimensionale noch langsamer und von verschachtelten ist absolut abzuraten (das steht ja auch schon in der Online-Hilfe). Deswegen habe ich mein 9x9 Array auch in ein 81-er-Array umgewandelt.

Wie soll es denn mit der Bewertung weitergehen? Ich werde wohl, wie Andy, auch noch weiterentwickeln, aber vergleichen müssten wir eigentlich die Stände vom 30.4.

Da nicht alle Solver alle Sudokus lösen können, müssten wir unterschiedliche Rätsel-Suiten zusammenstellen.

logische Sudokus mit einfachen Strategien, die alle Skripte lösen können
schwere Sudokus für die Backtracker bzw. die Kombinationen

Gruß BlackMail.

**Andy**

Hallo,
habe eben stundenlang Tests von allen Teilnehmern durchlaufen lassen und die Ergebnisse in einen Beitrag eingestellt und dann beim Forumsbeitrag statt VORSCHAU die F5 gedrückt....
Naja, jedenfalls bin ich für eine Umdefinierung der F5-Taste in SCITE!!!!!!EINSELF

Habe nochmal eine kleine Testroutine geschrieben:

Spoiler anzeigen

[autoit]

;#include "j:\desktop\autots\Sudokusolver_eukalyptus.au3"
;#include "j:\desktop\autots\Sudoku.au3"
;#include "j:\desktop\autots\Sudoku-helfer.au3"
;#include "j:\desktop\autots\leviathan\Sudoku_leviathan.au3"
;#include "j:\desktop\autots\leviathan\blackmail.au3"
Dim $testarray[100]

[/autoit] [autoit][/autoit] [autoit]

$testarray[1] = "000670900360005028805002100020506004009407000700100583070054261000703000084090050"
$testarray[2] = "628009000109056004500872001900510467807000030060020900004907103000201709091000280"
$testarray[3] = "076930000000108400300026000045080130010567090200310058068002005704000982020003710"
$testarray[4] = "120500360300009020007208004019000873403897001002350400000000087850016900200980140"
$testarray[5] = "906020100020050460000009730004260070700030608030871204800700041213000090490308006"
$testarray[6] = "007000300050908004900030060070004080102070900000500006800010000000000405060007000"
$testarray[7] = "060070008900104070003000500200007000008050906030900020000600010805000000000030007"
$testarray[8] = "000400050107000000000060003800003000001070904060900080040030001900502030006000700"
$testarray[9] = "004010050050900208300006000020000100000403000005000060000700005901004030070060900"
$testarray[10] = "500000006004902010070050900020004060900060803007100000000080200401000000000006070"
$testarray[11] = "009050200500000004000907000000204000100000005003010600035060720010000080074080510"
$testarray[12] = "200000140001209000500800000600700003070060000002004800009005000408100000000008067"
$testarray[13] = "000300150309001000200800000008009000100502000002000046600400007040060000005003200"
$testarray[14] = "003500100000010050700004008240000800000809002000700600000006009000200407015007000"
$testarray[15] = "000003050060004008800170000000710042040008700009005800790800000003050070004000200"
$testarray[16] = "000000000009040602087006010020004038040039000010008046064003050003050401000000000"
$testarray[17] = "000007002010000000000250108002030090006405000800090005004000609000500007607002840"
$testarray[18] = "000000000073080500092003070004070800708036020900000000000019650010000290000240000"
$testarray[19] = "060050002800000010000002600000020000500903208007010394006074000010006050200035000"
$testarray[20] = "004002080002000401500070060820040007060005100700000000090000023003098000000201600"
$testarray[21] = "000000000205980430006207009000030280040000000000090170009508006502460790000000000"
$testarray[22] = "000000800000640005009700004248000601060009000971000403003100008000570006000000700"
$testarray[23] = "000000020000008539000596080000000350051000700904700200402810000500040000086300000"
$testarray[24] = "000020000020000100365840070001050020840000000003060080214680030070000500000010000"
$testarray[25] = "700100002010070000008005300800000650006809000400300000009004000503600000000003071"
$testarray[26] = "100050000006009000080200004040030008007000060900000100030800002000004050000010700"
$testarray[27] = "000300800640800050875000001500070206000090000209080005400000769020008013007005000"
$testarray[28] = "050060001004800070800000052200057030000000000030690005790000008010006500500030060"
$testarray[29] = "080004060002000009760000012000806000800000003000107000670005041100000700050900020"
$testarray[30] = "000000000005010700070602090009020800060835010004070500030408020001090400000000000"
$testarray[31] = "060090050704050609000362000006005700982030546003600100000246000601070308050010060"
$testarray[32] = "007000000000010000000040005000008900400000000906007000008609000000000050030000041"
$testarray[33] = "530070000600195000098000060800060003400803001700020006060000280000419005000080079"
$testarray[34] = "100050000006009000080200004040030008007000060900000100030800002000004050000010700"
$testarray[35] = "000000103900050000000000800060020070001000000000300000000001460720000050000800000"
$testarray[36] = "000670900360005028805002100020506004009407000700100583070054261000703000084090050"
$testarray[37] = "628009000109056004500872001900510467807000030060020900004907103000201709091000280"
$testarray[38] = "076930000000108400300026000045080130010567090200310058068002005704000982020003710"
$testarray[39] = "120500360300009020007208004019000873403897001002350400000000087850016900200980140"
$testarray[40] = "906020100020050460000009730004260070700030608030871204800700041213000090490308006"
$testarray[41] = "007000300050908004900030060070004080102070900000500006800010000000000405060007000"
$testarray[42] = "060070008900104070003000500200007000008050906030900020000600010805000000000030007"
$testarray[43] = "000400050107000000000060003800003000001070904060900080040030001900502030006000700"
$testarray[44] = "004010050050900208300006000020000100000403000005000060000700005901004030070060900"
$testarray[45] = "500000006004902010070050900020004060900060803007100000000080200401000000000006070"
$testarray[46] = "009050200500000004000907000000204000100000005003010600035060720010000080074080510"
$testarray[47] = "700100002010070000008005300800000650006809000400300000009004000503600000000003071"
$testarray[48] = "200000140001209000500800000600700003070060000002004800009005000408100000000008067"
$testarray[49] = "000300150309001000200800000008009000100502000002000046600400007040060000005003200"
$testarray[50] = "000020000020000100365840070001050020840000000003060080214680030070000500000010000"
$testarray[51] = "003500100000010050700004008240000800000809002000700600000006009000200407015007000"
$testarray[52] = "000003050060004008800170000000710042040008700009005800790800000003050070004000200"
$testarray[53] = "000000000009040602087006010020004038040039000010008046064003050003050401000000000"
$testarray[54] = "000007002010000000000250108002030090006405000800090005004000609000500007607002840"
$testarray[55] = "000000000073080500092003070004070800708036020900000000000019650010000290000240000"
$testarray[56] = "060050002800000010000002600000020000500903208007010394006074000010006050200035000"
$testarray[57] = "004002080002000401500070060820040007060005100700000000090000023003098000000201600"
$testarray[58] = "000000000205980430006207009000030280040000000000090170009508006502460790000000000"
$testarray[59] = "000000800000640005009700004248000601060009000971000403003100008000570006000000700"
$testarray[60] = "000000020000008539000596080000000350051000700904700200402810000500040000086300000"
$testarray[61] = "000000103000050000000000800060020070001000000000300000000001460720000050000800000"
$testarray[62] = "100050000006009000080200004040030008007000060900000100030800002000004050000010700"
$testarray[63] = "000300800640800050805000001500070206000090000209080005400000709020008013007005000"
$testarray[64] = "050060001004800070800000052200057030000000000030690005790000008010006500500030060"
$testarray[65] = ".6....92..7.23.8.....7.1...8..........56.84..........3...4.7.....3.15.6..92....4."
$testarray[66] = "000000000005010700070602090009020800060835010004070500030408000001090400000000000"
$testarray[67] = "060090050000050609000362000006005700982030546003600100000246000601070308050010060"
$testarray[68] = "007000000000010000000040005000008900400000000906007000008609000000000050030000040"
$testarray[69] = "530070000600005000098000060800060003400803001700020006060000280000400005000080079"
$testarray[70] = "100050000006009000080200004040030008007000060900000100030800002000004050000010700"
$testarray[71] = "007000000000010000000040005000008900400000000906007000008609000000000050030000040"
$testarray[72] = "004620590000000200090700060060400370003000800089003050040001080001000000058074900"
$testarray[73] = "000060080020000000001000000070000102500030000000000400004201000300700600000000050"
$testarray[74] = "000000000000050000000000000060000000000000000070000000000000000800000000000000000"
$testarray[75] = "500000009020100070008000300040600000000050000000207010003000800060004020900000005"
$testarray[76] = "530000009020100070008000300040600000000050000000207010003000800060004020900000005" ;11 gefunden von nr 75

[/autoit] [autoit][/autoit] [autoit]

_test()
Exit

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _test()
Local $summe = 0, $brute = 0, $bruteflag = 0, $brutecounter = 0, $triple = 0, $rekurs = 0, $anzahlgefunden
Local $timer1 = 0, $geloeste = 0, $start = "", $solved, $loesung, $file, $z, $r, $s, $timer, $t, $beststring
$timer1 = TimerInit()
$geloeste = 0
For $p = 1 To 76 ;anzahl der zu prüfenden Sudokus anpassen

$start = $testarray[$p]
;$start = FileReadLine("vielesudokus.txt", $p) ;36000 sudokus
;$start = FileReadLine("35kergebnis.txt", $p)
;$start = FileReadLine("sudoku-loesung.dat", $p)
;$start = FileReadLine("boese_sudokus.txt",$p)
$summe += 1
$solved = 0
$timer = TimerInit()
$loesung = _solvesudoku($start)

[/autoit] [autoit][/autoit] [autoit]

;blackmails solver gibt nach einer gewissen zeit Strings zurück, die zwar gelöste Sudokus sind,
;aber mit dem Rätsel nichts zu tun haben
If _geloestx($loesung) = 1 And $loesung <> "123457689456189327789263514245631978317948265968725143531876492672394851894512736" Then
$geloeste = $geloeste + 1
$solved = 1
EndIf
$t = Int(TimerDiff($timer))
If $solved = 0 Then
$file = FileOpen("sudoku-loesung.dat", 1)
FileWriteLine($file, $start)
FileClose($file)
EndIf
ConsoleWrite($p & " " & $t & " " & $loesung & " " & $rekurs & " " & Int(TimerDiff($timer1) / 1000) & @CRLF)
Next
ConsoleWrite(@CRLF & "Sudokus: " & $geloeste & " von " & $summe & " gelöst in: " & (TimerDiff($timer1) / 1000) & " Sekunden" & @CRLF & @CRLF)
MsgBox(0, "Geloeste Sudokus: " & $geloeste, "Zeit: " & (TimerDiff($timer1) / 1000) & @CRLF & $anzahlgefunden & @CRLF & $summe)
EndFunc ;==>_test

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _geloestx($String) ;prüfen, ob 81er-string=reguläres sudoku d.h. nur eine ziffer in zeile/spalte/kasten
If StringLen($String) <> 81 Or StringInStr($String, "+") Then Return 3
Local $spalten[10]
Local $zeilen[10]
Local $box[10]

[/autoit] [autoit][/autoit] [autoit]

For $i = 1 To 81 Step 9 ;string in zeilen und kasten
$z = Int($i / 9) + 1
$zeilen[$z] = StringMid($String, $i, 9)

If _zifferdoppeltx($zeilen[$z]) <> 0 Then Return 0 ; msgbox(0,"ziffer in zeile "&$zeile[$z]&" doppelt","")
$s = Int($i / 27)
For $p = 0 To 2
$r = ($s * 3) + $p + 1
$box[$r] = $box[$r] & StringMid($zeilen[$z], ($p * 3) + 1, 3)

[/autoit] [autoit][/autoit] [autoit]

If _zifferdoppeltx($box[$r]) <> 0 Then Return 0 ;msgbox(0,"ziffer in box "&$box[$r]&" doppelt","")
Next
Next
For $z = 1 To 9
For $i = 1 To 9 ;ersetzen mit stringregexp
$spalten[$z] = $spalten[$z] & StringMid($zeilen[$i], $z, 1)
Next
If _zifferdoppeltx($spalten[$z]) <> 0 Then Return 0 ;msgbox(0,"ziffer in spalte "&$spalten[$z]&" doppelt","")
Next

[/autoit] [autoit][/autoit] [autoit]

If StringInStr($String, "0") Then
Return 2 ;Teilstring ist bisher ok
Else
Return 1 ;sudoku ist komplett gelöst
EndIf
EndFunc ;==>_geloestx

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

;================================================================================================
Func _zifferdoppeltx($test) ;wenn ziffer doppelt im string, dann return 1
If StringRegExp($test, "([1-9]).*\1") Then
Return 1
Else
Return 0
EndIf
EndFunc ;==>_zifferdoppeltx

[/autoit] [autoit][/autoit] [autoit][/autoit] [autoit]

Func _ziffernureinmalx($test, $a)
If StringInStr($test, $a) <> 0 And StringInStr($test, $a, 0, 2) = 0 Then
Return 1
Else
Return 0
EndIf
EndFunc ;==>_ziffernureinmalx

[/autoit] [autoit][/autoit] [autoit]

;================================================================================================

[/autoit]

Damit wurden, genau wie bei den 20 Sudokus, in etwa ähnliche Ergebnisse von Blackmail, Eukalyptus und mir erzielt.
Eukalyptus´ Backtracker scheint keine "Strategie" zum vorzeitigen Abbruch eingebaut zu haben, daher dauern einige Sudokus sehr lange, ich habe diese nach 10min abgebrochen. Bei den gelösten Sudokus (bis nr 72) löst er in etwa genauso schnell wie Blackmails und meiner.
Blackmails Solver gibt bei einigen Sudokus immer denselben String zurück, der zwar eine Lösung ist (leeres sudoku ausgefüllt?), aber mit der richtigen Lösung nichts zu tun hat^^

Hier nochmal meine Ergebnisse von den 20 Sudokus von allen Teilnehmern. Leviathans Solver bekam ich auf die schnelle nicht so umgestrickt, dass er mit der Testroutine verwendbar war.

Spoiler anzeigen

Ergebnisse:

Eukalyptus:
Sudoku Logisch 1 Richtig - Benötigte Zeit: 93.4297515466351
Sudoku Logisch 2 Richtig - Benötigte Zeit: 105.856749950063
Sudoku Logisch 3 Richtig - Benötigte Zeit: 105.742489618094
Sudoku Logisch 4 Richtig - Benötigte Zeit: 115.882605191442
Sudoku Logisch 5 Richtig - Benötigte Zeit: 106.442578595883
Sudoku Logisch 6 Richtig - Benötigte Zeit: 183.615515379748
Sudoku Logisch 7 Richtig - Benötigte Zeit: 221.026415368434
Sudoku Logisch 8 Richtig - Benötigte Zeit: 338.589401725638
Sudoku Logisch 9 Richtig - Benötigte Zeit: 235.669896593003
Sudoku Logisch 10 Richtig - Benötigte Zeit: 189.285789115656

Ergebnis Logisch: Zeit gesammt: 1695.5411930846 Zeit Durchschnitt: 169.55411930846

Sudoku Backtrack 1 Richtig - Benötigte Zeit: 2104.27889578145
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 6025.03893651288
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 536.318163341989
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 4865.44826227914
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 1026.22372396492
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 611.057829975597
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 287.264163462116
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 1973.48154583893
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 479.377965635297
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 5339.63087487376

Ergebnis Logisch: Zeit gesammt: 1695.5411930846 Zeit Durchschnitt: 169.55411930846
Ergebnis Backtrack: Zeit gesammt: 23248.1203616661 Zeit Durchschnitt: 2324.81203616661
Ergebnis gelöste Sudokus: 20

Funkey;
Sudoku Logisch 1 Richtig - Benötigte Zeit: 2292.75983400125
Sudoku Logisch 2 Richtig - Benötigte Zeit: 698.101574362105
Sudoku Logisch 3 Richtig - Benötigte Zeit: 796.123809031595
Sudoku Logisch 4 Richtig - Benötigte Zeit: 655.608743569364
Sudoku Logisch 5 Richtig - Benötigte Zeit: 1045.41638671954
Sudoku Logisch 6 Richtig - Benötigte Zeit: 3069.28171038498
Sudoku Logisch 7 Richtig - Benötigte Zeit: 3742.71869748809
Sudoku Logisch 8 Falsch
Sudoku Logisch 9 Richtig - Benötigte Zeit: 3357.70076923184
Sudoku Logisch 10 Richtig - Benötigte Zeit: 3224.0416030529

Ergebnis Logisch: Zeit gesammt: 24134.5634710557 Zeit Durchschnitt: 2413.45634710557

Sudoku Backtrack 1 Falsch
Sudoku Backtrack 2 Falsch
Sudoku Backtrack 3 Falsch
Sudoku Backtrack 4 Falsch
Sudoku Backtrack 5 Falsch
Sudoku Backtrack 6 Falsch
Sudoku Backtrack 7 Falsch
Sudoku Backtrack 8 Falsch
Sudoku Backtrack 9 Falsch
Sudoku Backtrack 10 Falsch

Ergebnis Logisch: Zeit gesammt: 24134.5634710557 Zeit Durchschnitt: 2413.45634710557
Ergebnis Backtrack: Zeit gesammt: 53114.8849923663 Zeit Durchschnitt: 5311.48849923663
Ergebnis gelöste Sudokus: 9

Andy:
Sudoku Logisch 1 Richtig - Benötigte Zeit: 113.587062042802
Sudoku Logisch 2 Richtig - Benötigte Zeit: 127.377641571764
Sudoku Logisch 3 Richtig - Benötigte Zeit: 123.374618841221
Sudoku Logisch 4 Richtig - Benötigte Zeit: 133.249616920586
Sudoku Logisch 5 Richtig - Benötigte Zeit: 125.700612787379
Sudoku Logisch 6 Richtig - Benötigte Zeit: 177.553013022605
Sudoku Logisch 7 Richtig - Benötigte Zeit: 186.293509370604
Sudoku Logisch 8 Richtig - Benötigte Zeit: 347.171218688409
Sudoku Logisch 9 Richtig - Benötigte Zeit: 184.979096505282
Sudoku Logisch 10 Richtig - Benötigte Zeit: 168.307983277204

Ergebnis Logisch: Zeit gesammt: 1687.59437302786 Zeit Durchschnitt: 168.759437302786

Sudoku Backtrack 1 Richtig - Benötigte Zeit: 1795.74750422191
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 3889.11858909442
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 719.368243729301
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 2355.40550544832
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 1066.96689104341
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 673.677241101872
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 257.63386128684
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 1662.56800794514
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 671.487856696871
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 3905.29857845061

Ergebnis Logisch: Zeit gesammt: 1687.59437302786 Zeit Durchschnitt: 168.759437302786
Ergebnis Backtrack: Zeit gesammt: 16997.2722790187 Zeit Durchschnitt: 1699.72722790187
Ergebnis gelöste Sudokus: 20

Blackmail:
Sudoku Logisch 1 Richtig - Benötigte Zeit: 154.968857773823
Sudoku Logisch 2 Richtig - Benötigte Zeit: 131.527330987598
Sudoku Logisch 3 Richtig - Benötigte Zeit: 138.637731890506
Sudoku Logisch 4 Richtig - Benötigte Zeit: 138.389655668528
Sudoku Logisch 5 Richtig - Benötigte Zeit: 139.44258278636
Sudoku Logisch 6 Richtig - Benötigte Zeit: 250.024514288827
Sudoku Logisch 7 Richtig - Benötigte Zeit: 256.196248405873
Sudoku Logisch 8 Richtig - Benötigte Zeit: 377.978206727391
Sudoku Logisch 9 Richtig - Benötigte Zeit: 242.500932381071
Sudoku Logisch 10 Richtig - Benötigte Zeit: 253.150051193657

Ergebnis Logisch: Zeit gesammt: 2082.81611210363 Zeit Durchschnitt: 208.281611210363

Sudoku Backtrack 1 Richtig - Benötigte Zeit: 1137.50155396845
Sudoku Backtrack 2 Richtig - Benötigte Zeit: 9556.92385484747
Sudoku Backtrack 3 Richtig - Benötigte Zeit: 457.79896606971
Sudoku Backtrack 4 Richtig - Benötigte Zeit: 504.163517989018
Sudoku Backtrack 5 Richtig - Benötigte Zeit: 888.127960397201
Sudoku Backtrack 6 Richtig - Benötigte Zeit: 842.655700654692
Sudoku Backtrack 7 Richtig - Benötigte Zeit: 241.729605298998
Sudoku Backtrack 8 Richtig - Benötigte Zeit: 1102.31691457993
Sudoku Backtrack 9 Richtig - Benötigte Zeit: 576.927514530478
Sudoku Backtrack 10 Richtig - Benötigte Zeit: 9595.4762406954

Ergebnis Logisch: Zeit gesammt: 2082.81611210363 Zeit Durchschnitt: 208.281611210363
Ergebnis Backtrack: Zeit gesammt: 24903.6218290313 Zeit Durchschnitt: 2490.36218290313
Ergebnis gelöste Sudokus: 20

3 Sieger, glücklichen Herzwunsch allen^^

**eukalyptus**

Ich habe angefangen, meinen Solver auf $aSudoku[81][9] - Array umzuschreiben. (statt BitAnd & Co)

Das geht relativ problemlos und die Geschwindigkeit nimmt deutlich zu

Weiters hab ich auch angefangen einen Logic-Backtracker zu schreiben, denn mein bisheriger ist ein Bruteforce-Algo.

Er funktioniert schon, jedoch benötigt er 20 mal solange, wie eure Algos

Da muß ich eure Scripte wohl noch genauer studieren

lgE