Sudoku solver

[qbguy]

Code: QB64: [Select]

1. DECLARE SUB UPDATEBOARD ()
2. DEFINT A-Z
3. CONST RANK = 3
4. CONST RANK2 = 9
5. CONST EDITOR = "notepad"
6. CONST FILE = "steps.txt"
7. CONST NUMBERS = "123456789"
8.  
9. DIM SHARED BLOCK(1 TO RANK2, 1 TO RANK2, 1 TO RANK2)
10. DIM SHARED PART(1 TO RANK2, 1 TO RANK2)
11. OPEN FILE FOR OUTPUT AS #1
12. CLS
13.  
14. DO
15.   PRINT "Which character would you like to use to represent blank (empty squares)? ";
16.   LINE INPUT BLANK$
17.   BLANK$ = LEFT$(LTRIM$(RTRIM$(BLANK$)), 1)
18.   IF BLANK$ = "" THEN BLANK$ = " "
19. LOOP UNTIL INSTR(NUMBERS, BLANK$) = 0
20. PRINT
21. PRINT "Enter your puzzle in plain text form.  Only numbers (1-9) and blanks have"
22. PRINT "significance. All other characters are ignored.  This means that the puzzle"
23. PRINT "may be input all on one line or with line breaks, spaces, and ASCII art to"
24. PRINT "mark block boundaries or beautify your input."
25. PRINT
26. NUMLEFT = 81
27. I = 1
28. J = 0
29. DO
30.   LINE INPUT LINE$
31.   FOR N = 1 TO LEN(LINE$)
32.     X$ = MID$(LINE$, N, 1)
33.     IF X$ = BLANK$ OR INSTR(NUMBERS, X$) THEN
34.       J = J + 1
35.       IF J > 9 THEN J = 1: I = I + 1
36.       PART(I, J) = INSTR(NUMBERS, X$)
37.       NUMLEFT = NUMLEFT - 1
38.     END IF
39.   NEXT
40. LOOP UNTIL NUMLEFT = 0
41. FOR ROW = 1 TO RANK2
42.   FOR COL = 1 TO RANK2
43.     FOR I = 1 TO RANK2
44.       IF PART(ROW, COL) = 0 THEN
45.         BLOCK(ROW, COL, I) = I
46.       END IF
47.     NEXT
48.   NEXT
49. NEXT
50.  
51. CALL UPDATEBOARD
52. DO
53. FOR ROW = 1 TO RANK2
54.     FOR VALL = 1 TO RANK2
55.       COUNT = 0
56.       FOR I = 1 TO RANK2
57.         IF BLOCK(ROW, I, VALL) = VALL THEN COUNT = COUNT + 1
58.       NEXT
59.       IF COUNT = 1 THEN
60.         FOR COL = 1 TO RANK2
61.           IF PART(ROW, COL) <> 0 THEN GOTO 2
62.           IF BLOCK(ROW, COL, VALL) = VALL THEN
63.               PART(ROW, COL) = VALL
64.               PRINT #1, "Only one instance of"; VALL; "in row"; ROW; "-- inserting at column"; COL
65.               FOR I = 1 TO RANK2
66.                 BLOCK(ROW, COL, I) = 0
67.               NEXT
68.               CALL UPDATEBOARD
69.               GOTO 4
70.           END IF
71. 2       NEXT
72.       ELSE
73.         BLK = -1
74.         FOR COL = 1 TO RANK2
75.           OLDBLK = BLK
76.           IF BLOCK(ROW, COL, VALL) = VALL THEN BLK = INT((COL - 1) / RANK)
77.           IF OLDBLK >= 0 AND BLK <> OLDBLK THEN GOTO 3
78.         NEXT
79.         IF BLK = -1 THEN GOTO 3
80.         FOR I = INT((ROW - 1) / RANK) * RANK + 1 TO INT((ROW - 1) / RANK) * RANK + RANK
81.           FOR J = BLK * RANK + 1 TO BLK * RANK + RANK
82.             IF I <> ROW AND BLOCK(I, J, VALL) <> 0 THEN
83.               BLOCK(I, J, VALL) = 0
84.               PRINT #1, "Eliminating"; VALL; "from"; I; J; "because it must be in row"; ROW; "in same block"
85.             END IF
86.           NEXT
87.         NEXT
88.       END IF
89. 3   NEXT
90. 4 NEXT
91. FOR COL = 1 TO RANK2
92.     FOR VALL = 1 TO RANK2
93.       COUNT = 0
94.       FOR I = 1 TO RANK2
95.         IF BLOCK(I, COL, VALL) = VALL THEN COUNT = COUNT + 1
96.       NEXT
97.       IF COUNT = 1 THEN
98.         FOR ROW = 1 TO RANK2
99.           IF PART(ROW, COL) <> 0 THEN GOTO 5
100.           IF BLOCK(ROW, COL, VALL) = VALL THEN
101.             PART(ROW, COL) = VALL
102.             PRINT #1, "Only one instance of"; VALL; "in column"; COL; "-- inserting at row"; ROW
103.             FOR I = 1 TO RANK2
104.               BLOCK(ROW, COL, I) = 0
105.             NEXT
106.             CALL UPDATEBOARD
107.             GOTO 7
108.           END IF
109. 5       NEXT
110.       ELSE
111.         BLK = -1
112.         FOR ROW = 1 TO RANK2
113.           OLDBLK = BLK
114.           IF BLOCK(ROW, COL, VALL) = VALL THEN BLK = INT((ROW - 1) / RANK)
115.           IF OLDBLK >= 0 AND BLK <> OLDBLK THEN GOTO 6
116.         NEXT
117.         IF BLK = -1 THEN GOTO 6
118.         FOR I = BLK * RANK + 1 TO BLK * RANK + RANK
119.           FOR J = INT((COL - 1) / RANK) * RANK + 1 TO INT((COL - 1) / RANK) * RANK + RANK
120.             IF J <> COL AND BLOCK(I, J, VALL) <> 0 THEN
121.               BLOCK(I, J, VALL) = 0
122.               PRINT #1, "Eliminating"; VALL; "from"; I; J; "because is must be in col"; COL; "in same block"
123.             END IF
124.           NEXT
125.         NEXT
126.       END IF
127. 6    NEXT
128. 7 NEXT
129. FOR I = 0 TO RANK - 1
130.   FOR J = 0 TO RANK - 1
131.     FOR VALL = 1 TO RANK2
132.       COUNT = 0
133.       FOR K = I * RANK + 1 TO I * RANK + RANK
134.         FOR L = J * RANK + 1 TO J * RANK + RANK
135.           IF BLOCK(K, L, VALL) = VALL THEN COUNT = COUNT + 1
136.         NEXT
137.       NEXT
138.       IF COUNT <> 1 THEN GOTO 9
139.       FOR K = I * RANK + 1 TO I * RANK + RANK
140.         FOR L = J * RANK + 1 TO J * RANK + RANK
141.           IF PART(K, L) <> 0 THEN GOTO 8
142.           IF BLOCK(K, L, VALL) = VALL THEN
143.             PART(K, L) = VALL
144.             PRINT #1, "Only one instance of"; VALL; "in box -- inserting at row"; K; "column"; L
145.             FOR M = 1 TO RANK2
146.               BLOCK(K, L, M) = 0
147.             NEXT
148.             CALL UPDATEBOARD
149.             GOTO 9
150.           END IF
151. 8       NEXT
152.       NEXT
153. 9   NEXT
154. 10  NEXT
155. NEXT
156. FOR ROW = 1 TO RANK2
157.   FOR COL = 1 TO RANK2
158.     IF PART(ROW, COL) <> 0 THEN GOTO 11
159.     COUNT = 0
160.     FOR VALL = 1 TO RANK2
161.       IF BLOCK(ROW, COL, VALL) = VALL THEN COUNT = COUNT + 1
162.     NEXT
163.     IF COUNT = 1 THEN
164.       FOR VALL = 1 TO RANK2
165.         IF BLOCK(ROW, COL, VALL) = VALL THEN
166.           PRINT #1, "Only"; VALL; "may be legally inserted at"; ROW; "column"; COL
167.           PART(ROW, COL) = VALL
168.           FOR I = 1 TO RANK2
169.             BLOCK(ROW, COL, I) = 0
170.           NEXT
171.           CALL UPDATEBOARD
172.           EXIT FOR
173.         END IF
174.       NEXT
175.     ELSEIF COUNT = 2 THEN
176.       FOR COL2 = 1 TO RANK2
177.         EXACT = -1
178.         FOR J = 1 TO RANK2
179.           IF BLOCK(ROW, COL2, J) <> BLOCK(ROW, COL, J) OR COL2 = COL THEN EXACT = 0: EXIT FOR
180.         NEXT
181.         IF EXACT THEN
182.           FOR I = 1 TO RANK2
183.             IF (I <> COL) AND (I <> COL2) THEN
184.               FOR J = 1 TO RANK2
185.                 IF BLOCK(ROW, I, J) = BLOCK(ROW, COL, J) AND BLOCK(ROW, I, J) <> 0 THEN
186.                   PRINT #1, "Eliminating "; J; "from"; ROW; I; "b/c naked pair at"; ROW; COL; "and"; ROW; COL2
187.                   BLOCK(ROW, I, J) = 0
188.                 END IF
189.               NEXT
190.             END IF
191.           NEXT
192.           EXIT FOR
193.         END IF
194.       NEXT
195.       FOR ROW2 = 1 TO RANK2
196.         EXACT = -1
197.         FOR J = 1 TO RANK2
198.           IF BLOCK(ROW2, COL, J) <> BLOCK(ROW, COL, J) OR ROW2 = ROW THEN EXACT = 0: EXIT FOR
199.         NEXT
200.         IF EXACT THEN
201.           FOR I = 1 TO RANK2
202.             IF (I <> ROW) AND (I <> ROW2) THEN
203.               FOR J = 1 TO RANK2
204.                 IF BLOCK(I, COL, J) = BLOCK(ROW, COL, J) AND BLOCK(I, COL, J) <> 0 THEN
205.                   BLOCK(I, COL, J) = 0
206.                   PRINT #1, "Eliminating "; J; "from"; I; COL; "b/c naked pair at"; ROW; COL; "and"; ROW2; COL
207.                 END IF
208.               NEXT
209.             END IF
210.           NEXT
211.           EXIT FOR
212.         END IF
213.       NEXT
214.       FOR I = INT((ROW - 1) / RANK) * RANK + 1 TO INT((ROW - 1) / RANK) * RANK + RANK
215.         FOR J = INT((COL - 1) / RANK) * RANK + 1 TO INT((COL - 1) / RANK) * RANK + RANK
216.           EXACT = -1
217.           FOR K = 1 TO RANK2
218.             IF (BLOCK(I, J, K) <> BLOCK(ROW, COL, K)) OR (I = ROW AND J = COL) THEN EXACT = 0: EXIT FOR
219.           NEXT
220.           IF EXACT THEN
221.             FOR M = INT((ROW - 1) / RANK) * RANK + 1 TO INT((ROW - 1) / RANK) * RANK + RANK
222.               FOR N = INT((COL - 1) / RANK) * RANK + 1 TO INT((COL - 1) / RANK) * RANK + RANK
223.                 IF ((M <> ROW OR N <> COL) AND (M <> I OR N <> J)) THEN
224.                   FOR K = 1 TO RANK2
225.                     IF BLOCK(ROW, COL, K) = BLOCK(M, N, K) AND BLOCK(M, N, K) <> 0 THEN
226.                       BLOCK(M, N, K) = 0
227.                       PRINT #1, "Eliminating "; K; "from"; M; N; "b/c naked pair at"; ROW; COL; "and"; I; J
228.                     END IF
229.                   NEXT
230.                 END IF
231.               NEXT
232.             NEXT
233.           GOTO 11
234.           END IF
235.         NEXT
236.       NEXT
237.     ELSE
238.       GOTO 11
239.     END IF
240. 11 NEXT
241. NEXT
242. OLDSUM = SUM
243. SUM = 0
244. SOLVED = -1
245. FOR I = 1 TO RANK2
246.   FOR J = 1 TO RANK2
247.     FOR K = 1 TO RANK2
248.       IF PART(I, J) = 0 THEN SOLVED = 0
249.       SUM = SUM + BLOCK(I, J, K)
250.     NEXT
251.   NEXT
252. NEXT
253. IF SOLVED THEN
254.   PRINT "Solution Found!"
255.   PRINT #1, "Solution Found!"
256.   EXIT DO
257. ELSEIF SUM = OLDSUM THEN
258.   PRINT "I seem to be stuck. Work so far:"
259.   EXIT DO
260. END IF
261. LOOP
262. FOR I = 1 TO RANK2
263.   FOR J = 1 TO RANK2
264.     PRINT PART(I, J);
265.     PRINT #1, PART(I, J);
266.   NEXT
267.   PRINT
268.   PRINT #1, ""
269. NEXT
270. CLOSE #1
271. PRINT
272. PRINT "Press ESCAPE to quit or any other key to see the steps"
273. PRINT "used to reach this point."
274. NULL$ = INPUT$(1)
275. IF NULL$ = CHR$(27) THEN
276.   SYSTEM
277. ELSE
278.   SHELL EDITOR + CHR$(32) + FILE
279. END IF
280.  
281. SUB UPDATEBOARD
282. FOR ROW = 1 TO RANK2
283.   FOR COL = 1 TO RANK2
284.     IF PART(ROW, COL) = 0 THEN GOTO 1
285.     FOR I = 1 TO RANK2
286.       IF BLOCK(ROW, I, PART(ROW, COL)) = PART(ROW, COL) THEN
287.         BLOCK(ROW, I, PART(ROW, COL)) = 0
288.       END IF
289.       IF BLOCK(I, COL, PART(ROW, COL)) = PART(ROW, COL) THEN
290.         BLOCK(I, COL, PART(ROW, COL)) = 0
291.       END IF
292.     NEXT
293.     FOR I = INT((ROW - 1) / RANK) * RANK + 1 TO INT((ROW - 1) / RANK) * RANK + RANK
294.       FOR J = INT((COL - 1) / RANK) * RANK + 1 TO INT((COL - 1) / RANK) * RANK + RANK
295.         IF BLOCK(I, J, PART(ROW, COL)) = PART(ROW, COL) THEN
296.           BLOCK(I, J, PART(ROW, COL)) = 0
297.         END IF
298.       NEXT
299.     NEXT
300. 1 NEXT
301. NEXT
302. END SUB
303.  

[bplus]

Hi qbguy,

Thanks to your post here. I have reviewed my own Sudoku App and took/am taking Sudoku Lessons from Sudoku Guy.

And thanks to that, I have a more enjoyable Sudoku app reworked where you can pencil in numbers to solve puzzles yourself:
http://qb64.freeforums.net/thread/109/sudoku-app

[jack]

here's a way to solve a sudoku game in under 60 seconds

[bplus]

HA! LOL the magic of the hand drawn button!

Here is key to solving a Sudoku in under 60 lines:

Code: QB64: [Select]

1. ' resolve sub written by cassiope01 on 18 Nov 2011,
2. ' modified very slightly by TyCamden on 19 Nov 2011,
3. ' modified more by me for testing code at JB in mainwin code:
4. ' use aok() function in place of ok() as it does
5. ' the same thing without string processing.
6.  
7. ' Now modified by me more, to use in SB but too many stack
8. ' overflow errors in SB, try QB64, Oh yeah!!! Nice...
9. SUB resolve ()
10.     FOR r = 0 TO 8
11.         FOR c = 0 TO 8
12.             IF grid(c, r) = 0 THEN
13.                 FOR n = 1 TO 9
14.                     IF aok(n, c, r) THEN
15.                         temp = grid(c, r)
16.                         grid(c, r) = -n
17.                         resolve
18.                         IF complete THEN EXIT SUB
19.                         grid(c, r) = temp
20.                     END IF
21.                 NEXT
22.                 EXIT SUB
23.             END IF
24.         NEXT
25.     NEXT
26. END SUB
27.  
28. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
29.     aok = 0
30.     IF grid(c, r) = 0 THEN 'check cell empty
31.         FOR i = 0 TO 8 'check row and column
32.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
33.         NEXT
34.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
35.         FOR rr = 0 TO 2
36.             FOR cc = 0 TO 2
37.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
38.             NEXT
39.         NEXT
40.         aok = 1
41.     END IF
42. END SUB
43.  
44. 'for resolve
45. FUNCTION complete () 'grid finished ?
46.     FOR r = 0 TO 8
47.         FOR c = 0 TO 8
48.             IF grid(c, r) = 0 THEN EXIT FUNCTION
49.         NEXT
50.     NEXT
51.     complete = 1
52. END FUNCTION
53.  

[TempodiBasic]

Hi QbGuy
Cool

I have given a change to your code testing the results... and just after the enter of the last line of input I've got immediately the solution of the sudoku... (see screenshot)!

I must admit that I am not a great solver of Sudoku, it may be because I have not learned the theory but I know only the basic rule:
in the same square AND in the same row AND in the same column there is one number (symbol) for each of the 9 numbers (symbols).

As soon as I'll go deeper in your code to see the solving path that you have used... and I have seen also the post of Jack, I'll go also there.

FEEDBACK:
1. low profile of interface, can it be included in an InForm interface?
2. Is it possible to load the scheme to solve from a file?
3. can be useful a timestamp and count of move/steps done to solve (like in Hanoi Tower) ?

Thanks to share

[TempodiBasic]

@JACLK

here's a way to solve a sudoku game in under 60 seconds

ROLF

PS in smiling I wrong your nickname LOL

[TempodiBasic]

@Bplus

Thanks for
1. the theory 

Thanks to your post here. I have reviewed my own Sudoku App and took/am taking Sudoku Lessons from Sudoku Guy.

2. the program
see screenshot
 

cool and fine!


FEEDBACK
1. I was fighting for a time to enter a my own puzzle, then I put 0 for each cell and then I input the new puzzle
 1.1 LOL I haven't read well all Help screen so after done this and screenshot I have learned about choice 9 for blank puzzle
  1.2 nice the feature that you cannot do a wrong input in  Editor mode. If the number that you are putting is wrong for position it
       will not be put in that cell
  1.3  hateful feature in Editor mode (make) if I input a wrong number to change it I must before put 0 and then I can put another
        number
2. very fine mouse support.
3. fine feedback are in loading saving solving!
     3.1 it lacks of message in wrong operation of user like my dummies actions talked above! :-)
 

[bplus]

  1.3  hateful feature in Editor mode (make) if I input a wrong number to change it I must before put 0 and then I can put another
        number

Hi TempodiBasic,

Thanks for feedback! I have noticed problem with changing a number as well and want it to work like the cell notes (right click on cell for number in keypad or shift + number from upper row (US keyboard at least) to toggle number into/out of cell notes. Don't need to clear it first with 0 as you said.

I revised allot of stuff since "Workheet" post. Now you can toggle ON/OFF an overlay of a transparent solution to see how you are progressing with the code calculated solution (which may or may not be unique). Here is your puzzle input and check of solution.
 

Here is your puzzle after first sweeps as taught by Sudoku Guy:
 

Almost done:
 

[bplus]

Here is a Quick Solver.

Enter your puzzle into your favorite text editor, save file as: Quick Solve This Sudoku.txt,
in same folder as the Sudoku Quick Solve.exe

Code: QB64: [Select]

1. _TITLE "Sudoku Quick Solve" 'B+ started 2019-05-05
2.  
3. '          use your favorite editor and make a text file called - Quick Solve This Sudoku.txt
4. '        use any non number symbol for spaces or 0 (no commas), and type 9 rows of nine numbers and space symbols
5. '
6. '            run this program in same folder and it will append the solution if there is one
7.  
8. DIM SHARED grid(8, 8) AS INTEGER
9. OPEN "Quick Solve This Sudoku.txt" FOR INPUT AS #1
10. FOR row = 0 TO 8
11.     INPUT #1, fline$
12.     'PRINT fline$
13.     FOR col = 0 TO 8
14.         grid(col, row) = VAL(MID$(fline$, col + 1, 1))
15.         PRINT grid(col, row);
16.     NEXT
17.     PRINT
18. NEXT
19. CLOSE #1
20. resolve
21. OPEN "Quick Solve This Sudoku.txt" FOR APPEND AS #1
22. PRINT #1, " "
23. PRINT #1, STRING$(27, "+")
24. PRINT
25. FOR row = 0 TO 8
26.     'PRINT fline$
27.     FOR col = 0 TO 8
28.         PRINT #1, ABS(grid(col, row));
29.         PRINT grid(col, row);
30.     NEXT
31.     PRINT #1, " "
32.     PRINT
33. NEXT
34. CLOSE #1
35. PRINT "File ready"
36.  
37. ' resolve sub written by cassiope01 on 18 Nov 2011,
38. ' modified very slightly by TyCamden on 19 Nov 2011,
39. ' modified more by me for testing code at JB in mainwin code:
40. ' use aok() function in place of ok() as it does
41. ' the same thing without string processing.
42.  
43. ' Now modified by me more, to use in SB but too many stack
44. ' overflow errors in SB, try QB64, Oh yeah!!! Nice...
45. SUB resolve ()
46.     FOR r = 0 TO 8
47.         FOR c = 0 TO 8
48.             IF grid(c, r) = 0 THEN
49.                 FOR n = 1 TO 9
50.                     IF aok(n, c, r) THEN
51.                         temp = grid(c, r)
52.                         grid(c, r) = -n
53.                         resolve
54.                         IF complete THEN EXIT SUB
55.                         grid(c, r) = temp
56.                     END IF
57.                 NEXT
58.                 EXIT SUB
59.             END IF
60.         NEXT
61.     NEXT
62. END SUB
63.  
64. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
65.     aok = 0
66.     IF grid(c, r) = 0 THEN 'check cell empty
67.         FOR i = 0 TO 8 'check row and column
68.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
69.         NEXT
70.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
71.         FOR rr = 0 TO 2
72.             FOR cc = 0 TO 2
73.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
74.             NEXT
75.         NEXT
76.         aok = 1
77.     END IF
78. END SUB
79.  
80. 'for resolve
81. FUNCTION complete () 'grid finished ?
82.     FOR r = 0 TO 8
83.         FOR c = 0 TO 8
84.             IF grid(c, r) = 0 THEN EXIT FUNCTION
85.         NEXT
86.     NEXT
87.     complete = 1
88. END FUNCTION
89.  
90.  
91.  

Here is TempodiBasic's puzzle:

530070000
600195000
098000060
800060003
400803001
700020006
060000280
000419005
000000079

And file after run:

530070000
600195000
098000060
800060003
400803001
700020006
060000280
000419005
000000079
+++++++++++++++++++++++++++
 5  3  4  6  7  8  9  1  2 
 6  7  2  1  9  5  3  4  8 
 1  9  8  3  4  2  5  6  7 
 8  5  9  7  6  1  4  2  3 
 4  2  6  8  5  3  7  9  1 
 7  1  3  9  2  4  8  5  6 
 9  6  1  5  3  7  2  8  4 
 2  8  7  4  1  9  6  3  5 
 3  4  5  2  8  6  1  7  9 

[bplus]

Here is the Quick Solver modified to see if more than one solution is possible. It performs 36 tests alternating the place to start filling (from top left corner of puzzle or from bottom right corner of puzzle) and alternating the start number to try the fill attempt. Although it does not attempt to find every possible solution, it should be able to tell if a solution is unique or not.

Code: QB64: [Select]

1. _TITLE "Sudoku Unique Solution Test" 'B+ started 2019-05-06
2. '
3. '  Check to see if a Sudoku puzzle has a unique soln or more than 1.
4. '
5. '        Use your favorite editor and make a text file called - Check Unique Sudoku.txt
6. '        Use any non number symbol for spaces (no commas),
7. '        and type 9 rows of nine numbers and space symbols for the puzzle.
8. '
9. '        Run this program in same folder and it will append the solution(s) found.
10. '
11.  
12. SCREEN _NEWIMAGE(840, 600, 32) 'wide enough to display solution in a string * 81
13. _SCREENMOVE _MIDDLE
14. DIM SHARED grid(8, 8) AS INTEGER, gridCopy(8, 8) AS INTEGER
15. DIM solns$(1 TO 9 * 4) ' try 36 tests, might have different solution for each
16. SI = 0 'soln index
17.  
18. 'get the puzzle to check from file
19. IF _FILEEXISTS("Check Unique Sudoku.txt") THEN
20.     OPEN "Check Unique Sudoku.txt" FOR INPUT AS #1
21.     FOR row = 0 TO 8
22.         INPUT #1, fline$
23.         'PRINT fline$
24.         FOR col = 0 TO 8
25.             grid(col, row) = VAL(MID$(fline$, col + 1, 1))
26.             gridCopy(col, row) = grid(col, row) 'make copy
27.             PRINT grid(col, row);
28.         NEXT
29.         PRINT
30.     NEXT
31.     CLOSE #1
32. ELSE
33.     PRINT "Can't find: Check Unique Sudoku.txt file."
34. END IF
35.  
36. PRINT: PRINT "Solution(s) found:"
37.  
38. 'get solution(s)
39.  
40. 'resolve2 fills in a puzzle from the top left corner
41. FOR ns = 1 TO 9
42.     resolve2 ns 'this sould solve everytime no matter where start N
43.     GOSUB addSoln 'restore grid to pretest conditions
44.     FOR r = 0 TO 8
45.         FOR c = 0 TO 8
46.             grid(c, r) = gridCopy(c, r)
47.         NEXT
48.     NEXT
49. NEXT
50.  
51. ' now try fill in numbers in reverse order
52. FOR ns = 9 TO 1 STEP -1 'resolve 2 fills in a puzzle from the top left corner
53.     resolve2 ns 'this sould solve everytime no matter where start N
54.     GOSUB addSoln 'restore grid to pretest conditions
55.     FOR r = 0 TO 8
56.         FOR c = 0 TO 8
57.             grid(c, r) = gridCopy(c, r)
58.         NEXT
59.     NEXT
60. NEXT
61.  
62. 'resolve3 fills in Sudoku puzzle from the bottom right corner
63. FOR ns = 1 TO 9
64.     resolve3 ns 'work the grid from the other end
65.     GOSUB addSoln
66.     'restore grid to pretest conditions
67.     FOR r = 0 TO 8
68.         FOR c = 0 TO 8
69.             grid(c, r) = gridCopy(c, r)
70.         NEXT
71.     NEXT
72. NEXT
73.  
74. FOR ns = 9 TO 1 STEP -1
75.     resolve3 ns 'work the grid from the other end
76.     GOSUB addSoln
77.     'restore grid to pretest conditions
78.     FOR r = 0 TO 8
79.         FOR c = 0 TO 8
80.             grid(c, r) = gridCopy(c, r)
81.         NEXT
82.     NEXT
83. NEXT
84.  
85. ' OK file results
86. OPEN "Check Unique Sudoku.txt" FOR APPEND AS #1
87. PRINT #1, " "
88. FOR i = 1 TO SI
89.     PRINT #1, STRING$(18, "+")
90.     FOR r = 0 TO 8
91.         s$ = ""
92.         FOR c = 0 TO 8
93.             s$ = s$ + MID$(solns$(i), r * 9 + c + 1, 1) + " "
94.         NEXT
95.         PRINT #1, s$
96.     NEXT
97. NEXT
98. CLOSE #1
99.  
100. PRINT: PRINT "Done checking puzzle, file updated with solutions found."
101. END
102.  
103. addSoln:
104. 'string the soln
105. b$ = ""
106. FOR row = 0 TO 8
107.     'PRINT fline$
108.     FOR col = 0 TO 8
109.         b$ = b$ + _TRIM$(STR$(ABS(grid(col, row))))
110.     NEXT
111. NEXT
112. 'check if we have a copy already
113. bIsCopy = 0
114. FOR index = 1 TO SI
115.     IF b$ = solns$(index) THEN bIsCopy = 1: EXIT FOR
116. NEXT
117. IF bIsCopy = 0 THEN
118.     PRINT b$
119.     SI = SI + 1
120.     solns$(SI) = b$
121. END IF
122. RETURN
123.  
124. SUB resolve2 (startN)
125.     FOR r = 0 TO 8
126.         FOR c = 0 TO 8
127.             IF grid(c, r) = 0 THEN
128.                 FOR nMod = startN TO startN + 8
129.                     IF nMod > 9 THEN n = nMod - 9 ELSE n = nMod
130.                     IF aok(n, c, r) THEN
131.                         temp = grid(c, r)
132.                         grid(c, r) = -n
133.                         resolve2 startN
134.                         IF complete THEN EXIT SUB
135.                         grid(c, r) = temp
136.                     END IF
137.                 NEXT
138.                 EXIT SUB
139.             END IF
140.         NEXT
141.     NEXT
142. END SUB
143.  
144. SUB resolve3 (startN)
145.     FOR r = 8 TO 0 STEP -1
146.         FOR c = 8 TO 0 STEP -1
147.             IF grid(c, r) = 0 THEN
148.                 FOR nMod = startN TO startN + 8
149.                     IF nMod > 9 THEN n = nMod - 9 ELSE n = nMod
150.                     IF aok(n, c, r) THEN
151.                         temp = grid(c, r)
152.                         grid(c, r) = -n
153.                         resolve3 startN
154.                         IF complete THEN EXIT SUB
155.                         grid(c, r) = temp
156.                     END IF
157.                 NEXT
158.                 EXIT SUB
159.             END IF
160.         NEXT
161.     NEXT
162. END SUB
163.  
164. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
165.     aok = 0
166.     IF grid(c, r) = 0 THEN 'check cell empty
167.         FOR i = 0 TO 8 'check row and column
168.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
169.         NEXT
170.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
171.         FOR rr = 0 TO 2
172.             FOR cc = 0 TO 2
173.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
174.             NEXT
175.         NEXT
176.         aok = 1
177.     END IF
178. END SUB
179.  
180. FUNCTION complete () 'grid finished ?
181.     FOR r = 0 TO 8
182.         FOR c = 0 TO 8
183.             IF grid(c, r) = 0 THEN EXIT FUNCTION
184.         NEXT
185.     NEXT
186.     complete = 1
187. END FUNCTION
188.  
189.  
190.  

Here is results of puzzle that had multiple solutions (made from older version of Sudoku App that just systematically hid x amount of cells in each block:

500400070
009030200
010002004
050060020
600500700
007004005
080001007
001300050
200090400
++++++++++++++++++
5 2 3 4 8 6 1 7 9
7 4 9 1 3 5 2 8 6
8 1 6 9 7 2 5 3 4
4 5 8 7 6 3 9 2 1
6 3 2 5 1 9 7 4 8
1 9 7 8 2 4 3 6 5
3 8 4 2 5 1 6 9 7
9 6 1 3 4 7 8 5 2
2 7 5 6 9 8 4 1 3
++++++++++++++++++
5 2 3 4 8 6 9 7 1
7 4 9 1 3 5 2 8 6
8 1 6 9 7 2 5 3 4
4 5 8 7 6 3 1 2 9
6 3 2 5 1 9 7 4 8
1 9 7 8 2 4 3 6 5
3 8 4 2 5 1 6 9 7
9 6 1 3 4 7 8 5 2
2 7 5 6 9 8 4 1 3
++++++++++++++++++
5 3 2 4 8 6 9 7 1
7 4 9 1 3 5 2 8 6
8 1 6 9 7 2 5 3 4
3 5 4 7 6 9 1 2 8
6 2 8 5 1 3 7 4 9
1 9 7 8 2 4 3 6 5
4 8 3 2 5 1 6 9 7
9 6 1 3 4 7 8 5 2
2 7 5 6 9 8 4 1 3
++++++++++++++++++
5 6 2 4 8 9 1 7 3
7 4 9 1 3 5 2 6 8
8 1 3 6 7 2 5 9 4
1 5 4 7 6 8 3 2 9
6 9 8 5 2 3 7 4 1
3 2 7 9 1 4 6 8 5
4 8 6 2 5 1 9 3 7
9 7 1 3 4 6 8 5 2
2 3 5 8 9 7 4 1 6
++++++++++++++++++
5 2 6 4 8 9 1 7 3
7 4 9 1 3 5 2 8 6
3 1 8 6 7 2 5 9 4
1 5 4 7 6 8 3 2 9
6 9 2 5 1 3 7 4 8
8 3 7 9 2 4 6 1 5
4 8 3 2 5 1 9 6 7
9 6 1 3 4 7 8 5 2
2 7 5 8 9 6 4 3 1
++++++++++++++++++
5 3 2 4 8 6 1 7 9
7 4 9 1 3 5 2 8 6
8 1 6 9 7 2 5 3 4
1 5 4 7 6 9 3 2 8
6 9 8 5 2 3 7 4 1
3 2 7 8 1 4 6 9 5
4 8 3 2 5 1 9 6 7
9 6 1 3 4 7 8 5 2
2 7 5 6 9 8 4 1 3
++++++++++++++++++
5 6 2 4 8 9 1 7 3
7 4 9 1 3 5 2 8 6
8 1 3 6 7 2 5 9 4
1 5 4 8 6 7 3 2 9
6 9 8 5 2 3 7 4 1
3 2 7 9 1 4 8 6 5
4 8 6 2 5 1 9 3 7
9 7 1 3 4 8 6 5 2
2 3 5 7 9 6 4 1 8

And here is a puzzle copied from a Sudoku book that has one solution:

000001350
564039000
071000900
040120003
023040570
800063020
002000730
000450618
058300000
++++++++++++++++++
2 8 9 6 7 1 3 5 4
5 6 4 2 3 9 1 8 7
3 7 1 5 8 4 9 6 2
7 4 6 1 2 5 8 9 3
1 2 3 9 4 8 5 7 6
8 9 5 7 6 3 4 2 1
4 1 2 8 9 6 7 3 5
9 3 7 4 5 2 6 1 8
6 5 8 3 1 7 2 4 9

And here is an encouraging sign, I just tested a Level 8 puzzle created by my latest version of Sudoku App. Level 8 leaves in this case 25 clues and hiding 56 cells and still generates a puzzle with a single solution (at least by my test with code here).

Now the question is, is it solvable? I am too unskilled at Sudoku to tell. ;-))
 

PS, yeah I know, I can remove 3 redundant blocks of code with one GOSUB for restoring the grid back to gridCopy. :)

[bplus]

 2 in a row! Anyone want to give it a shot? :)