The New Sudoku Players' Forum

[Guest]

Here is a VB-Script to calculate Sudoku's...

Public Feld(9,9)
Public PosX, PosY
Public History(9,9,9)
Public Vorgaben(9,9)
Public Vorher
Public StartTime, EndTime

call main


Public Function main()

StartTime = Timer

'Vorgaben werden in Array geschrieben
Feld(1,8) = 3
Feld(1,9) = 8
Feld(2,2) = 2
Feld(2,3) = 3
Feld(2,4) = 4
Feld(2,6) = 8
Feld(3,2) = 8
Feld(3,4) = 5
Feld(3,5) = 2
Feld(3,7) = 1
Feld(3,9) = 9
Feld(4,4) = 6
Feld(4,5) = 7
Feld(4,6) = 4
Feld(4,8) = 5
Feld(6,2) = 1
Feld(6,4) = 3
Feld(6,5) = 5
Feld(6,6) = 9
Feld(7,1) = 1
Feld(7,3) = 5
Feld(7,5) = 4
Feld(7,6) = 7
Feld(7,8) = 9
Feld(8,4) = 9
Feld(8,6) = 2
Feld(8,7) = 7
Feld(8,8) = 1
Feld(9,1) = 2
Feld(9,2) = 9

PosX = 1
PosY = 1

Vorher = 1

For i = 1 to 9
For j = 1 to 9
If Not Feld(i,j) = "" Then
Vorgaben(i,j) = True
Else
Vorgaben(i,j) = False
End if

For k = 1 to 9
History(i,j,k) = False
Next
Next
Next





Do While PosX < 10 And PosY < 10

'msgbox output()
' msgbox "Feld(" & PosY & "," & PosX & ")"
If defined(PosX,PosY) = False Then

If Feld(PosY,PosX) = "" Then

' msgbox "Feld(" & PosY & "," & PosX & ") ist leer"
For a = 1 to 9
If Feld(PosY,PosX) = "" Then
If checkh(a,PosY) = False And checkv(a,PosX) = False And checkq(a, PosX, PosY) = False then
Feld(PosY,PosX) = a

History(PosY,PosX,a) = True
' msgbox "Feld(" & PosY & "," & PosX & ") wurde mit " & a & " gefüllt." & chr(10) & "History("& PosY & "," & PosX & "," & a & ") = True"
End if
Else
End if
Next
if Feld(PosY,PosX) = "" Then

' msgbox "Feld(" & PosY & "," & PosX & ") ist immernoch leer --> back"
call back(PosX,PosY)
Else

' msgbox "Feld(" & PosY & "," & PosX & ") ist gefüllt --> next"
call nextf(PosX,PosY)
End if
Else

'if PosY = 2 And PosX = 9 Then msgbox "Feld(" & PosY & "," & PosX & ") ist schon ausgefüllt und hat den Wert " & Feld(PosY,PosX) & chr(10) & "History("& PosY & "," & PosX & "," & Feld(PosY,PosX) & ") = " & History(PosY,PosX,Feld(PosY,PosX))
test = 0
a = 0
Wert = Feld(PosY,PosX)
' msgbox output()
Do While test < 1
If Wert = 9 Then
Wert = 1
Else
Wert = Wert + 1
End if
'if PosY = 2 And PosX = 9 Then msgbox "Feld(" & PosY & "," & PosX & ") Wert " & Wert & " wird getestet. History("& PosY & "," & PosX & "," & Wert & ") = " & History(PosY,PosX,Wert)

If History(PosY,PosX,Wert) = False Then

If checkh(Wert,PosY) = False And checkv(Wert,PosX) = False And checkq(Wert, PosX, PosY) = False then
Feld(PosY,PosX) = Wert

History(PosY,PosX,Feld(PosY,PosX)) = True
'if PosY = 2 And PosX = 9 Then msgbox "Feld(" & PosY & "," & PosX & ") Wert " & Wert & " wurde eingesetzt. --> next" & chr(10) & "History("& PosY & "," & PosX & "," & Wert & ") = " & History(PosY,PosX,Wert)
call nextf(PosX,PosY)
Exit Do
Else

'if PosY = 2 And PosX = 9 Then msgbox "Feld(" & PosY & "," & PosX & ") Wert " & Wert & " ist Vorhanden."
test = 0
a = a + 1
End if
Else

'if PosY = 2 And PosX = 9 Then Msgbox "Feld(" & PosY & "," & PosX & ") Wert " & Wert & " wurde schon versucht." & chr(10) & "History("& PosY & "," & PosX & "," & Wert & ") = " & History(PosY,PosX,Wert)
a = a + 1
End if
'If PosY = 2 And PosX = 9 then msgbox "Hier ist Feld 2,9"
If a = 9 then
'if PosY = 2 And PosX = 9 Then msgbox "Feld(" & PosY & "," & PosX & ") Schlaufe wurde 9 mal durchlaufen 1 Feld zurück"
Feld(PosY,PosX) = ""
call back(PosX, PosY)
Exit Do
End if
Loop
'End if
End if
Else

If Vorher = 1 then
call nextf(PosX,PosY)
Else
call back(PosX,PosY)
End if
End if
Loop

EndTime = Timer
'Ergebnis wird ausgedruckt
'msgbox output()
msgbox "***********************" & chr(10) & output() & chr(10) & "***********************" & chr(10) & "Verbrauchte Zeit: " & EndTime - StartTime

End Function





Public Function nextf(PosX, PosY)
' Do While 0 < 1
Vorher = 1
If PosX = 9 And PosY < 9 Then
PosX = 1
PosY = PosY + 1
Else
PosX = PosX + 1
End if

' if defined(PosX,PosY) = False then
' Exit Do
' End if
' Loop
End Function



Public Function back(PosX, PosY)
Vorher = 0
' Do While 0 < 1
test = False
For i = 1 to 9
History(PosY,PosX,i) = False
Next


'Positionen zurück
If PosX > 1 And PosY > 1 Then
'msgbox "Feld(" & PosY & "," & PosX & ") nach Feld(" & PosY & "," & PosX - 1 & ")"
PosX = PosX - 1
test = True
End if

If PosX = 1 And PosY > 1 And test = False Then
'msgbox "Feld(" & PosY & "," & PosX & ") nach Feld(" & PosY - 1 & "," & 9 & ")"
PosX = 9
PosY = PosY - 1
test = True

End if
If PosX > 1 And PosY = 1 And test = False Then
'msgbox "Feld(" & PosY & "," & PosX & ") nach Feld(" & PosY & "," & PosX - 1 & ")"
PosX = PosX - 1
test = True
End if

' if defined(PosY,PosX) = False Then
' Exit Do
' End if

' Loop
End Function




'Kontrolle ob Wert Horizontal schon besteht
Public Function checkh(Wert, PosY)
For a = 1 to 9
If Feld(PosY,a) = Wert Then
checkh = True
Exit For
Else
checkh = False
End if
Next
End Function

'Kontrolle ob Wert Vertikal schon besteht
Public Function checkv(Wert, PosX)
For a = 1 to 9
If Feld(a,PosX) = Wert Then
checkv = True
Exit For
Else
checkv = False
End if
Next
End Function

'Kontrolle ob Wert im Quadrat schon besteht
Public Function checkq(Wert, PosX, PosY)
Dim Ya, Yb, Xa, Xb

If PosY < 4 Then
Ya = 1
Yb = 3
End if
If PosY > 3 And PosY < 7 Then
Ya = 4
Yb = 6
End if
If PosY > 6 Then
Ya = 7
Yb = 9
End if

If PosX < 4 Then
Xa = 1
Xb = 3
End if
If PosX > 3 And PosX < 7 Then
Xa = 4
Xb = 6
End if
If PosX > 6 Then
Xa = 7
Xb = 9
End if

For a = Ya to Yb
For b = Xa to Xb
If Feld(a,b) = Wert Then
checkq = True
Exit For
Else
checkq = False
End if
Next
if checkq = True Then
Exit For
End if
Next
End Function





'Kontrolle ob Feld vorgegeben return true or false
Public Function defined(PosX, PosY)
'defined = Null

If Vorgaben(PosY,PosX) = True then
defined = True
Else
defined = False
End if
End Function
























'Ausgabe wird formatiert
Public Function output()
Dim i, j, Ausgabe

For i = 1 To 9
For j = 1 To 9
If Feld(i,j) = "" Then
Ausgabe = Ausgabe & "_" & " ; "
Else
Ausgabe = Ausgabe & Feld(i,j) & " ; "
End If
Next
Ausgabe = Ausgabe & chr(10)
j = 1
Next

output = Ausgabe
End Function