January 16, 2021, 06:10:26 AM

### Author Topic: [bmx] Sudoku solver by Matt Merkulov [ 1+ years ago ]  (Read 411 times)

#### BlitzBot

• Jr. Member
•  • Posts: 1 ##### [bmx] Sudoku solver by Matt Merkulov [ 1+ years ago ]
« on: June 29, 2017, 12:28:39 AM »
Title : Sudoku solver
Author : Matt Merkulov
Posted : 1+ years ago

Description : First number is the quantity of defined squares.
Second number represents failed guess attempts.

Program uses variant-exclusion mechanism + guessing system with backup stack for failed attempts.

Code :
Code: BlitzMax
1. SuperStrict
2.
3. Type LTFinished
4.  Field N:Int, M:Int
5. End Type
6.
7. Type LTBackup
8.  Field N:Int, M:Int
9.  Field Guess:Int
10. End Type
11.
12. Type LTBackupChoice
13.  Field N:Int, M:Int
14.  Field Guesses:Int[]
15.  Field Choice:Int
16. End Type
17.
18. Global GameField:Int[,] = New Int[ 9, 9 ]
19. Global Guess:Int[,,] = New Int[ 9, 9, 9 ]
20. Global FinishedQuantity:Int = 0
21. Global Faults:Int = 0
22.
23. Global Font:TImageFont[] = New TImageFont[ 2 ]
24. Font[ 0 ] = LoadImageFont( "C:WindowsFontsarial.ttf", 51 )
25. Font[ 1 ] = LoadImageFont( "C:WindowsFontsarial.ttf", 17 )
26.
27. Graphics 800, 600
28.
29. Global FinishedStack:TList = New TList
30. Global UndoStack:TList
31.
32. DrawText( "Do you want to use stored puzzle (y/n)?", 0, 0 )
33. Flip
34. Local UseStored:Int = 0
35.
36. Repeat
37.  If KeyHit( KEY_N ) Then Exit
38.  If KeyHit( KEY_Y ) Then
39.   UseStored = 1
40.   Exit
41.  End If
42. Forever
43.
44. For Local M:Int = 0 Until 9
45.  For Local N:Int = 0 Until 9
46.   Local V:Int = 0
47.   If UseStored Then ReadData V
48.
49.   If V Then
50.    Guess[ N, M, V - 1 ] = 1
51.    GameField[ N, M ] = -1
53.   Else
54.    GameField[ N, M ] = -9
55.    For Local K:Int = 0 Until 9
56.     Guess[ N, M, K ] = 1
57.    Next
58.   End If
59.  Next
60. Next
61.
62. DefData  0, 0, 0,   0, 8, 0,   0, 0, 0
63. DefData  9, 0, 0,   0, 6, 0,   0, 3, 1
64. DefData  0, 0, 0,   2, 0, 1,   0, 0, 7
65.
66. DefData  0, 6, 0,   0, 0, 0,   0, 2, 0
67. DefData  7, 3, 0,   5, 0, 0,   9, 8, 0
68. DefData  1, 0, 0,   0, 0, 2,   0, 0, 0
69.
70. DefData  0, 0, 8,   0, 0, 0,   0, 0, 0
71. DefData  0, 0, 0,   7, 2, 5,   0, 0, 0
72. DefData  0, 0, 0,   0, 0, 8,   3, 1, 0
73.
74. Repeat
75.  Draw()
76.
77.  Local Finished:LTFinished = LTFinished( FinishedStack.First() )
78.  If Finished Then
79.   DebugLog Finished.N + ", " + Finished.M
80.
81.   If GameField[ Finished.N, Finished.M ] <> -1 Then
82.    debuglog GameField[ Finished.N, Finished.M ]
83.    Faults :+ 1
84.    RollBackup()
85.    Continue
86.   End If
87.
88.   Local N:Int = Finished.N
89.   Local M:Int = Finished.M
90.
91.   Local Variant:Int = -1
92.   For Local K:Int = 0 Until 9
93.    If Guess[ N, M, K ] Then
94.     Variant = K
95.     Exit
96.    End If
97.   Next
98.
99.   Local QuadrantN:Int = Floor( N / 3 ) * 3
100.   Local QuadrantM:Int = Floor( M / 3 ) * 3
101.   For Local K:Int = 0 Until 9
102.    reemoveVariant( K, M, Variant )
103.    reemoveVariant( N, K, Variant )
104.    reemoveVariant( QuadrantN + ( K Mod 3 ), QuadrantM + Floor( K / 3 ), Variant )
105.   Next
106.   GameField[ N, M ] = Variant + 1
107.   'Waitkey
108.   FinishedQuantity :+ 1
109.
110.   If FinishedQuantity = 81 Then
111.    Draw()
112.    Waitkey
113.    End
114.   End If
115.
116.   FinishedStack.RemoveFirst()
117.  Else
118.   Local MinN:Int = 0
119.   Local MinM:Int = 0
120.   Local MinQ:Int = 9
121.
122.   For Local N:Int = 0 Until 9
123.    For Local M:Int = 0 Until 9
124.     If GameField[ N, M ] < 0 Then
125.      Local Quantity:Int = 0
126.      For Local K:Int = 0 Until 9
127.       If Guess[ N, M, K ] Then Quantity :+ 1
128.      Next
129.      If Quantity < MinQ Then
130.       MinQ = Quantity
131.       MinN = N
132.       MinM = M
133.      End If
134.     End If
135.    Next
136.   Next
137.
138.   If Not UndoStack Then UndoStack = New TList
139.   Local BackupChoice:LTBackupChoice = New LTBackupChoice
140.   BackupChoice.N = MinN
141.   BackupChoice.M = MinM
142.   BackupChoice.Guesses = New Int[ 9 ]
144.
145.   Local Variant:Int =  -1
146.   For Local K:Int = 0 Until 9
147.    BackupChoice.Guesses[ K ] = Guess[ MinN, MinM, K ]
148.    If Guess[ MinN, MinM, K ] And Variant = -1 Then
149.     Variant = K
150.    Else
151.     Guess[ MinN, MinM, K ] = 0
152.    End If
153.   Next
154.
156.   GameField[ MinN, MinM ] = -1
157.   BackupChoice.Choice = Variant
158.
159.   Draw()
160.  End If
161.
162.  Flip
163.
164. Until KeyHit( KEY_ESCAPE )
165.
166.
167.
168. Function CenterText( Text:String, X:Int, Y:Int, Font:TImageFont )
169.  SetImageFont( Font )
170.  DrawText( Text, X - TextWidth( Text ) / 2, Y - TextHeight( Text ) / 2 )
171. End Function
172.
173.
174.
175. Function reemoveVariant( N:Int, M:Int, Variant:Int )
176.  If Guess[ N, M, Variant ] Then
177.   GameField[ N, M ] :+ 1
178.   Guess[ N, M, Variant ] = 0
179.   If GameField[ N, M ] = -1 Then AddFinished( N, M )
180.
181.   If UndoStack Then
182.    Local Backup:LTBackup = New LTBackup
183.    Backup.N = N
184.    Backup.M = M
185.    Backup.Guess = Variant
187.   End If
188.  End If
189. End Function
190.
191.
192.
193. Function RollBackup()
194.  If Not UndoStack Then RuntimeError( "This board has no solution!" )
195.  If UndoStack.Count() = 0 Then RuntimeError( "This board has no solution!" )
196.  Repeat
197.   Local Backup:LTBackup = LTBackup( UndoStack.First() )
198.   If Backup Then
199.    If GameField[ Backup.N, Backup.M ] > 0 Then
200.     FinishedQuantity :- 1
201.     GameField[ Backup.N, Backup.M ] = 0
202.    End If
203.    GameField[ Backup.N, Backup.M ] :- 1
204.    Guess[ Backup.N, Backup.M, Backup.Guess ] = 1
205.    UndoStack.RemoveFirst()
206.    Draw()
207.   Else
208.    Local BackupChoice:LTBackupChoice = LTBackupChoice( UndoStack.First() )
209.
210.    Local N:Int = BackupChoice.N
211.    Local M:Int = BackupChoice.M
212.    Guess[ N, M, BackupChoice.Choice ] = 0
213.
214.    For Local K:Int = BackupChoice.Choice + 1 Until 9
215.     If BackupChoice.Guesses[ K ] Then
216.      GameField[ N, M ] = -1
217.      Guess[ N, M, K ] = 1
218.      BackupChoice.Choice = K
219.      FinishedStack.Clear()
221.      draw()
222.      Return
223.     End If
224.    Next
225.
226.    For Local K:Int = 0 Until 9
227.     Guess[ BackupChoice.N, BackupChoice.M, K ] = BackupChoice.Guesses[ K ]
228.    Next
229.
230.    UndoStack.RemoveFirst()
231.    RollBackup()
232.   End If
233.  Forever
234. End Function
235.
236.
237.
238. Function AddFinished( N:Int, M:Int )
239.  Local Finished:LTFinished = New LTFinished
240.  Finished.N = N
241.  Finished.M = M
243. End Function
244.
245.
246.
247. Function Draw()
248.  Cls
249.
250.  For Local N:Int = 0 To 9
251.   Local V:Int = 0
252.   If ( N Mod 3 ) = 0 Then V = 1
253.   DrawRect 32 + N * 60 - V * 2, 30, 1 + V * 4, 544
254.   DrawRect 30, 32 + N * 60 - V * 2, 544, 1 + V * 4
255.  Next
256.
257.  For Local N:Int = 0 Until 9
258.   For Local M:Int = 0 Until 9
259.    If GameField[ M, N ] > 0 Then
260.     CenterText( GameField[ M, N ], 62 + M * 60, 62 + N * 60, Font[ 0 ] )
261.    Else
262.     For Local K:Int = 0 Until 9
263.      If Guess[ M, N, K ] Then CenterText( K + 1, 42 + M * 60 + ( K Mod 3 ) * 20, 42 + N * 60 + Floor( K / 3 ) * 20, Font[ 1 ] )
264.     Next
265.    End If
266.   Next
267.  Next
268.
269.  SetImageFont( Font[ 0 ] )
270.  DrawText( FinishedQuantity, 800 - TextWidth( FinishedQuantity ), 0 )
271.  SetColor 255, 0, 0
272.  If Faults Then DrawText( Faults, 800 - TextWidth( Faults ), 50 )
273.  SetColor 255, 255, 255
274.
275.  Flip
276. End Function