This is the start of a unique solver where it doesn't use brute force or recursion to solve the puzzles. Instead, it uses different solving techniques like Hidden Singles, Hidden Pairs, etc. to try and solve the puzzles. Currently only Hidden Singles are available and can solve 4 of the 6 included puzzles.
Five puzzles are included:
1 Wikipedia Example
2 Simple Puzzle #1
3 Easy Puzzle #1
4 Medium Puzzle #1
5 Hard Puzzle #1
6 Genius Puzzle #1
Puzzles 2-6 are puzzles from the Boy Howdy Sudoku app on iOS.
Code: Select all
Dim As Integer wScreen=56*8, hScreen=40*16
ScreenRes wScreen, hScreen, 32
Dim As Integer wText=wScreen\8, hText=hScreen\16
Width wText, hText
Sub Pause
Sleep 100: If InKey=Chr(27) Then End
End Sub
Sub VirtPrint(x As Integer, y As Integer, Text As String, Colour As ULong)
If x<1 Or y<1 Or x>56*8 Or y>40*16 Then Exit Sub
Color Colour: Locate y, x, 0: Print Text;
End Sub
Sub Setup(Puzzle As String, Grid() As Integer, BoardArt() As String, NumArt() As String, _
Colour As ULong)
Dim As Integer ff=FreeFile
Open "Droidoku.bin" For Binary As #ff
BoardArt(0)=Space(4): Get #ff, , BoardArt(0)
Dim As Integer w=Asc(Mid(BoardArt(0), 2, 1)), h=Asc(Mid(BoardArt(0), 3, 1))
For t As Integer=1 To h: BoardArt(t)=Space(w): Get #ff, , BoardArt(t): Next
Close #ff
Dim As Integer x=Grid(0, 0), y=Grid(0, 1)
Color Colour
For t As Integer=0 To h-1: VirtPrint x, y+t, BoardArt(t+1), Colour: Next
For y As Integer=1 To 9
For x As Integer=1 To 9: Grid(x, y)=Val(Mid(Puzzle, 9*(y-1)+x, 1)): Next
Next
End Sub
Function Possible(Row As Integer, Col As Integer, Value As Integer, Grid() As Integer) As Integer
Dim As String RowScan, ColScan, RegScan, tStr
For Row As Integer=1 to 9
If Grid(Row, Col) Then RowScan=RowScan+Hex(Grid(Row, Col))
Next
' Value found? Return 0 (Unable to use the Value)
If InStr(RowScan, Hex(Value)) Then Return 0
For Col As Integer=1 To 9
If Grid(Row, Col) Then ColScan=ColScan+Hex(Grid(Row, Col))
Next
' Value found? Return 0 (Unable to use the Value)
If InStr(ColScan, Hex(Value)) Then Return 0
' Get the Region start position
Dim As Integer t1=(Row-1)\3, tx=3*t1+1, t2=(Col-1)\3, ty=3*t2+1
For Col As Integer=0 to 2
For Row As Integer=0 to 2
If Grid(tx+Row, ty+Col) Then RegScan=RegScan+Hex(Grid(tx+Row, ty+Col))
Next
Next
' Value found? Return 0 (Unable to use the Value)
If InStr(RegScan, Hex(Value)) Then Return 0
' Value not found Return 1 (able to use the Value)
Return 1
End Function
Function Solved(Grid() As Integer) As Integer
For Col As Integer=1 to 9
For Row As Integer=1 To 9
' Is the Cell empty? Return 0 (Puzzle unsolved)
If Grid(Row, Col)=0 Then Return 0
Next
Next
' No Empty cells - Puzzle solved
Return 1
End Function
Sub Position(Row As Integer, Col As Integer)
Dim As Integer tx=(Row-1)\3+1, ty=(Col-1)\3
VirtPrint 48, 38, " Row "+Hex(Row), RGB(255, 255, 255)
VirtPrint 48, 39, "Column "+Hex(Col), RGB(255, 255, 255)
VirtPrint 48, 40, "Region "+Hex(3*ty+tx), RGB(255, 255, 255)
End Sub
Sub ShowMarks(Row As Integer, Col As Integer, Mark As String)
Dim As Integer cx=6*(Row-1)+2, cy=4*(Col-1)+2
' Show Pencil Marks
For t As Integer=1 To Len(Mark)
Dim As Integer Value=Val(Mid(Mark, t, 1))
Dim As Integer tx=(Value-1) Mod 3, ty=(Value-1)\3
VirtPrint 2*tx+cx, cy+ty, Hex(Value), RGB(255, 215, 0)
Next
End Sub
Sub Pencil(Grid() As Integer, Marks() As String, Tag As Integer=0)
For Col As Integer=1 To 9
For Row As Integer=1 to 9
Position Row, Col
' Pencil Marks
Marks(Row, Col)=""
' Is the Cell empty?
If Grid(Row, Col)=0 Then
' Check all Possible Values 1-9
For Value As Integer=1 To 9
' If Possible add the value to the Pencil Marks
If Possible(Row, Col, Value, Grid()) Then
Marks(Row, Col)=Marks(Row, Col)+Hex(Value)
If Tag Then ShowMarks Row, Col, Marks(Row, Col)
EndIf
Next
EndIf
Next
Next
End Sub
' Shows where on the Grid it is working (not used)
Sub TagCell(x As Integer, y As Integer, Tag As Integer)
If Tag Then
For t As Integer=2 to 4: VirtPrint x+2, y+t, Space(5), RGB(255, 215, 0): Next
Else
VirtPrint x+2, y+2, "|\ /|", RGB(255, 0, 0)
VirtPrint x+2, y+3, "| |", RGB(255, 0, 0)
VirtPrint x+2, y+4, "|/ \|", RGB(255, 0, 0)
EndIf
Pause
End Sub
Sub ShowGrid(Grid() As Integer)
Dim As Integer x=Grid(0, 0), y=Grid(0, 1)
For Col As Integer=1 To 9
For Row As Integer=1 To 9
Dim As Integer cx=6*(Row-1), cy=4*(Col-1)
If Grid(Row, Col) Then
VirtPrint cx+x+1, cy+y+1, Space(5), RGB(255, 0, 0)
VirtPrint cx+x+1, cy+y+2, " "+Hex(Grid(Row, Col))+" ", RGB(255, 0, 0)
VirtPrint cx+x+1, cy+y+3, Space(5), RGB(255, 0, 0)
EndIf
Next
Next
End Sub
Sub HiddenSingles(Grid() As Integer, Marks() As String)
VirtPrint 2, 38, "Hidden Singles....", RGB(25, 255, 255)
' Get Pencil Marks - 1 is optional and will place them on the grid
Pencil Grid(), Marks(), 1
' Go through the entire Grid
For Col As Integer=1 To 9
For Row As Integer=1 to 9
Position Row, Col
' If only one pencil mark, then this is a Hidden Single
If Len(Marks(Row, Col))=1 Then
Grid(Row, Col)=Val(Marks(Row, Col))
Dim As Integer cx=6*(Row-1), cy=4*(Col-1)
VirtPrint cx+Grid(0, 0)+1, cy+Grid(0, 1)+1, Space(5), RGB(0, 255, 0)
VirtPrint cx+Grid(0, 0)+1, cy+Grid(0, 1)+2, " "+Hex(Grid(Row, Col))+" ", RGB(0, 255, 0)
VirtPrint cx+Grid(0, 0)+1, cy+Grid(0, 1)+3, Space(5), RGB(0, 255, 0)
EndIf
Next
Next
End Sub
Sub HiddenPairs(Grid() As Integer, Marks() As String)
VirtPrint 2, 38, "Hidden Pairs....", RGB(25, 255, 255)
' Get Pencil Marks - 1 is optional and will place them on the grid
Pencil Grid(), Marks(), 1
End Sub
Dim As String Puzzle(8)
' Empy Puzzle
Puzzle(1)="000000000000000000000000000000000000000000000000000000000000000000000000000000000"
' Wikipedia Puzzle
Puzzle(1)="530070000600195000098000060800060003400803001700020006060000280000419005000080079"
' Simple Puzzle
Puzzle(2)="000006007001902340890000012046013500010090060009560720970000035065708200200400000"
' Easy Puzzle
Puzzle(3)="900835001000009500073200800350401706100000002709308054008007230005600000400952008"
' Medium Puzzle
Puzzle(4)="300150040570030020804000000000091070290000051080370000000000603050040092060028004"
' Hard Puzzle
Puzzle(5)="970050000201090700400800010007029000300000009000640200010008005005060102000010083"
' Genius Puzzle
Puzzle(6)="600001000490080060008070200007200085000108000830007600003010900080090013000400006"
Dim As String Style
Dim As Integer Done
Dim As Integer Grid(9,9)
Grid(0, 0)=1: Grid(0, 1)=1
Dim As String BoardArt(56), NumArt(10), Marks(9, 9)
For t As Integer=1 To 6
Setup Puzzle(t), Grid(), BoardArt(), NumArt(), RGB(255, 215, 0)
ShowGrid Grid()
Select Case t
Case 1: Style="Wikipedia"
Case 2: Style="Simple"
Case 3: Style="Easy"
Case 4: Style="Medium"
Case 5: Style="Hard"
Case 6: Style="Genius"
End Select
Dim As Integer Stuck=0
While Not Done
VirtPrint 2, 40, "Solving "+Style+" Puzzle....", RGB(255, 215, 0): Pause
HiddenSingles Grid(), Marks()
If Stuck=20 Then
'HiddenPairs Grid(), Marks()
EndIf
If Solved(Grid()) Then Exit While
Wend
For t As Integer=0 To 2
VirtPrint 2, 38+t, Space(54), RGB(255, 215, 0)
Next
Sleep
Next
Sleep