07-10-2024, 09:36 AM
WFC based Sudoku Solver, cannot solve hard sudokus unfortunately 
An example sudoku is loaded, but you can use arrow keys and numbers from 0 to 9 (0 to clear) to input in grid...
Hit enter and see the magic
An example sudoku is loaded, but you can use arrow keys and numbers from 0 to 9 (0 to clear) to input in grid...
Hit enter and see the magic
Code: (Select All)
Screen _NewImage(18, 11, 0)
DefLng A-Z
Dim Grid(1 To 9, 1 To 9) As _Unsigned _Byte
Dim Omit(1 To 9, 1 To 9) As _Unsigned _Bit * 9
For I = 1 To 9: For J = 1 To 9
Read Grid(J, I)
Next J, I
Color 15, 0
PX = 1: PY = 1
Do
Cls , 0
_Limit 60
K$ = InKey$: Select Case K$
Case "0" To "9": Grid(PX, PY) = Val(K$): PX = PX + 1: If PX = 10 Then PX = 1: PY = PY + 1
If PY = 10 Then PY = 1
Case Chr$(13): Exit Do
Case Chr$(27): System
Case Chr$(0) + "H": If PY > 1 Then PY = PY - 1
Case Chr$(0) + "P": If PY < 9 Then PY = PY + 1
Case Chr$(0) + "K": If PX > 1 Then PX = PX - 1
Case Chr$(0) + "M": If PX < 9 Then PX = PX + 1
End Select
For I = 1 To 9
For J = 1 To 9
If PX = J And PY = I Then Color , 3 Else Color , 0
If Grid(J, I) Then Print Str$(Grid(J, I)); Else Print " ";
If J = 9 Then Print
Next J, I
_Display
Loop
_Title "Working"
Do
S = 0
Cls , 0
_Limit 10
GoSub UpdateOmit
For I = 1 To 9
For J = 1 To 9
'-------Solve-------
If Grid(J, I) = 0 Then
S = S + 1
End If
If Omit(J, I) Then
For K = 1 To 9
If _SetBit(Omit(J, I), K - 1) = 511 Then
Grid(J, I) = K
Exit For
End If
Next K
End If
'-------------------
'------Display------
If Grid(J, I) Then Print Str$(Grid(J, I)); Else Print " ";
If J = 9 Then Print
'-------------------
Next J, I
_Display
Loop While S
_Title "Done"
_Delay 1
Sleep
System
UpdateOmit:
For I = 1 To 9
For J = 1 To 9
For K = 1 To 9
If K = I Then _Continue
If Grid(K, J) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(K, J) - 1)
Next K
For K = 1 To 9
If K = J Then _Continue
If Grid(I, K) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(I, K) - 1)
Next K
__I = 3 * ((I - 1) \ 3)
__J = 3 * ((J - 1) \ 3)
For II = __I + 1 To __I + 3
For JJ = __J + 1 To __J + 3
If II = I And JJ = J Then _Continue
If Grid(II, JJ) Then Omit(I, J) = _SetBit(Omit(I, J), Grid(II, JJ) - 1)
Next JJ, II
Next J, I
Return
Data 9,0,6,3,4,0,8,1,0
Data 0,5,1,7,0,0,3,0,0
Data 4,7,0,0,9,1,0,0,5
Data 0,0,0,9,0,3,0,0,2
Data 0,0,2,0,8,7,0,0,0
Data 1,0,7,2,0,0,6,0,0
Data 0,8,5,0,0,9,1,0,0
Data 0,3,4,0,6,0,0,0,9
Data 0,1,0,5,0,8,7,0,6