Author Topic: Sudoku solver  (Read 5508 times)

0 Members and 1 Guest are viewing this topic.

Offline qbguy

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #1 on: May 02, 2019, 11:02:18 am »
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

Offline jack

  • Seasoned Forum Regular
  • Posts: 408
    • View Profile
Re: Sudoku solver
« Reply #2 on: May 02, 2019, 12:00:44 pm »
here's a way to solve a sudoku game in under 60 seconds

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #3 on: May 02, 2019, 01:09:35 pm »
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.  
  27. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
  28.     aok = 0
  29.     IF grid(c, r) = 0 THEN 'check cell empty
  30.         FOR i = 0 TO 8 'check row and column
  31.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
  32.         NEXT
  33.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
  34.         FOR rr = 0 TO 2
  35.             FOR cc = 0 TO 2
  36.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
  37.             NEXT
  38.         NEXT
  39.         aok = 1
  40.     END IF
  41.  
  42. 'for resolve
  43. FUNCTION complete () 'grid finished ?
  44.     FOR r = 0 TO 8
  45.         FOR c = 0 TO 8
  46.             IF grid(c, r) = 0 THEN EXIT FUNCTION
  47.         NEXT
  48.     NEXT
  49.     complete = 1
  50.  

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Sudoku solver
« Reply #4 on: May 05, 2019, 05:49:32 am »
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) ?
Sudoku solver QbGuy.jpg


Thanks to share
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Sudoku solver
« Reply #5 on: May 05, 2019, 05:58:43 am »
@JACLK
Quote
here's a way to solve a sudoku game in under 60 seconds
ROLF

PS in smiling I wrong your nickname LOL
« Last Edit: May 05, 2019, 06:29:20 am by TempodiBasic »
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Sudoku solver
« Reply #6 on: May 05, 2019, 06:27:56 am »
@Bplus

Thanks for
1. the theory 
Quote
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
 
Sudoku WorkSheet Bplus.jpg


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! :-)
 
Sudoku WorkSheet Bplus.jpg
Programming isn't difficult, only it's  consuming time and coffee

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #7 on: May 05, 2019, 09:29:06 am »
Quote
  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.
 
rework check soln tempodi.PNG


Here is your puzzle after first sweeps as taught by Sudoku Guy:
 
rework first sweeps on the way to solve tempodi.PNG


Almost done:
 
rework almost done tempodi puzzle.PNG



« Last Edit: May 05, 2019, 09:35:30 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #8 on: May 05, 2019, 10:19:37 am »
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. resolve
  19. OPEN "Quick Solve This Sudoku.txt" FOR APPEND AS #1
  20. PRINT #1, " "
  21. PRINT #1, STRING$(27, "+")
  22. FOR row = 0 TO 8
  23.     'PRINT fline$
  24.     FOR col = 0 TO 8
  25.         PRINT #1, ABS(grid(col, row));
  26.         PRINT grid(col, row);
  27.     NEXT
  28.     PRINT #1, " "
  29.     PRINT
  30. PRINT "File ready"
  31.  
  32. ' resolve sub written by cassiope01 on 18 Nov 2011,
  33. ' modified very slightly by TyCamden on 19 Nov 2011,
  34. ' modified more by me for testing code at JB in mainwin code:
  35. ' use aok() function in place of ok() as it does
  36. ' the same thing without string processing.
  37.  
  38. ' Now modified by me more, to use in SB but too many stack
  39. ' overflow errors in SB, try QB64, Oh yeah!!! Nice...
  40. SUB resolve ()
  41.     FOR r = 0 TO 8
  42.         FOR c = 0 TO 8
  43.             IF grid(c, r) = 0 THEN
  44.                 FOR n = 1 TO 9
  45.                     IF aok(n, c, r) THEN
  46.                         temp = grid(c, r)
  47.                         grid(c, r) = -n
  48.                         resolve
  49.                         IF complete THEN EXIT SUB
  50.                         grid(c, r) = temp
  51.                     END IF
  52.                 NEXT
  53.                 EXIT SUB
  54.             END IF
  55.         NEXT
  56.     NEXT
  57.  
  58. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
  59.     aok = 0
  60.     IF grid(c, r) = 0 THEN 'check cell empty
  61.         FOR i = 0 TO 8 'check row and column
  62.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
  63.         NEXT
  64.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
  65.         FOR rr = 0 TO 2
  66.             FOR cc = 0 TO 2
  67.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
  68.             NEXT
  69.         NEXT
  70.         aok = 1
  71.     END IF
  72.  
  73. 'for resolve
  74. FUNCTION complete () 'grid finished ?
  75.     FOR r = 0 TO 8
  76.         FOR c = 0 TO 8
  77.             IF grid(c, r) = 0 THEN EXIT FUNCTION
  78.         NEXT
  79.     NEXT
  80.     complete = 1
  81.  
  82.  
  83.  

Here is TempodiBasic's puzzle:
Quote
530070000
600195000
098000060
800060003
400803001
700020006
060000280
000419005
000000079

And file after run:
Quote
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 


Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #9 on: May 07, 2019, 03:49:04 pm »
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. DIM SHARED grid(8, 8) AS INTEGER, gridCopy(8, 8) AS INTEGER
  14. DIM solns$(1 TO 9 * 4) ' try 36 tests, might have different solution for each
  15. SI = 0 'soln index
  16.  
  17. 'get the puzzle to check from file
  18. IF _FILEEXISTS("Check Unique Sudoku.txt") THEN
  19.     OPEN "Check Unique Sudoku.txt" FOR INPUT AS #1
  20.     FOR row = 0 TO 8
  21.         INPUT #1, fline$
  22.         'PRINT fline$
  23.         FOR col = 0 TO 8
  24.             grid(col, row) = VAL(MID$(fline$, col + 1, 1))
  25.             gridCopy(col, row) = grid(col, row) 'make copy
  26.             PRINT grid(col, row);
  27.         NEXT
  28.         PRINT
  29.     NEXT
  30.     CLOSE #1
  31.     PRINT "Can't find: Check Unique Sudoku.txt file."
  32.  
  33. PRINT: PRINT "Solution(s) found:"
  34.  
  35. 'get solution(s)
  36.  
  37. 'resolve2 fills in a puzzle from the top left corner
  38. FOR ns = 1 TO 9
  39.     resolve2 ns 'this sould solve everytime no matter where start N
  40.     GOSUB addSoln 'restore grid to pretest conditions
  41.     FOR r = 0 TO 8
  42.         FOR c = 0 TO 8
  43.             grid(c, r) = gridCopy(c, r)
  44.         NEXT
  45.     NEXT
  46.  
  47. ' now try fill in numbers in reverse order
  48. FOR ns = 9 TO 1 STEP -1 'resolve 2 fills in a puzzle from the top left corner
  49.     resolve2 ns 'this sould solve everytime no matter where start N
  50.     GOSUB addSoln 'restore grid to pretest conditions
  51.     FOR r = 0 TO 8
  52.         FOR c = 0 TO 8
  53.             grid(c, r) = gridCopy(c, r)
  54.         NEXT
  55.     NEXT
  56.  
  57. 'resolve3 fills in Sudoku puzzle from the bottom right corner
  58. FOR ns = 1 TO 9
  59.     resolve3 ns 'work the grid from the other end
  60.     GOSUB addSoln
  61.     'restore grid to pretest conditions
  62.     FOR r = 0 TO 8
  63.         FOR c = 0 TO 8
  64.             grid(c, r) = gridCopy(c, r)
  65.         NEXT
  66.     NEXT
  67.  
  68. FOR ns = 9 TO 1 STEP -1
  69.     resolve3 ns 'work the grid from the other end
  70.     GOSUB addSoln
  71.     'restore grid to pretest conditions
  72.     FOR r = 0 TO 8
  73.         FOR c = 0 TO 8
  74.             grid(c, r) = gridCopy(c, r)
  75.         NEXT
  76.     NEXT
  77.  
  78. ' OK file results
  79. OPEN "Check Unique Sudoku.txt" FOR APPEND AS #1
  80. PRINT #1, " "
  81. FOR i = 1 TO SI
  82.     PRINT #1, STRING$(18, "+")
  83.     FOR r = 0 TO 8
  84.         s$ = ""
  85.         FOR c = 0 TO 8
  86.             s$ = s$ + MID$(solns$(i), r * 9 + c + 1, 1) + " "
  87.         NEXT
  88.         PRINT #1, s$
  89.     NEXT
  90.  
  91. PRINT: PRINT "Done checking puzzle, file updated with solutions found."
  92.  
  93. addSoln:
  94. 'string the soln
  95. b$ = ""
  96. FOR row = 0 TO 8
  97.     'PRINT fline$
  98.     FOR col = 0 TO 8
  99.         b$ = b$ + _TRIM$(STR$(ABS(grid(col, row))))
  100.     NEXT
  101. 'check if we have a copy already
  102. bIsCopy = 0
  103. FOR index = 1 TO SI
  104.     IF b$ = solns$(index) THEN bIsCopy = 1: EXIT FOR
  105. IF bIsCopy = 0 THEN
  106.     PRINT b$
  107.     SI = SI + 1
  108.     solns$(SI) = b$
  109.  
  110. SUB resolve2 (startN)
  111.     FOR r = 0 TO 8
  112.         FOR c = 0 TO 8
  113.             IF grid(c, r) = 0 THEN
  114.                 FOR nMod = startN TO startN + 8
  115.                     IF nMod > 9 THEN n = nMod - 9 ELSE n = nMod
  116.                     IF aok(n, c, r) THEN
  117.                         temp = grid(c, r)
  118.                         grid(c, r) = -n
  119.                         resolve2 startN
  120.                         IF complete THEN EXIT SUB
  121.                         grid(c, r) = temp
  122.                     END IF
  123.                 NEXT
  124.                 EXIT SUB
  125.             END IF
  126.         NEXT
  127.     NEXT
  128.  
  129. SUB resolve3 (startN)
  130.     FOR r = 8 TO 0 STEP -1
  131.         FOR c = 8 TO 0 STEP -1
  132.             IF grid(c, r) = 0 THEN
  133.                 FOR nMod = startN TO startN + 8
  134.                     IF nMod > 9 THEN n = nMod - 9 ELSE n = nMod
  135.                     IF aok(n, c, r) THEN
  136.                         temp = grid(c, r)
  137.                         grid(c, r) = -n
  138.                         resolve3 startN
  139.                         IF complete THEN EXIT SUB
  140.                         grid(c, r) = temp
  141.                     END IF
  142.                 NEXT
  143.                 EXIT SUB
  144.             END IF
  145.         NEXT
  146.     NEXT
  147.  
  148. FUNCTION aok (a, c, r) 'check to see if a is OK to place at (c, r)
  149.     aok = 0
  150.     IF grid(c, r) = 0 THEN 'check cell empty
  151.         FOR i = 0 TO 8 'check row and column
  152.             IF ABS(grid(i, r)) = a OR ABS(grid(c, i)) = a THEN EXIT FUNCTION
  153.         NEXT
  154.         cbase = INT(c / 3) * 3: rbase = INT(r / 3) * 3
  155.         FOR rr = 0 TO 2
  156.             FOR cc = 0 TO 2
  157.                 IF ABS(grid(cbase + cc, rbase + rr)) = a THEN EXIT FUNCTION
  158.             NEXT
  159.         NEXT
  160.         aok = 1
  161.     END IF
  162.  
  163. FUNCTION complete () 'grid finished ?
  164.     FOR r = 0 TO 8
  165.         FOR c = 0 TO 8
  166.             IF grid(c, r) = 0 THEN EXIT FUNCTION
  167.         NEXT
  168.     NEXT
  169.     complete = 1
  170.  
  171.  
  172.  

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:
Quote
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:
Quote
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. ;-))
 
Test a level 8 puzzle created by latest Sudoku app.PNG


PS, yeah I know, I can remove 3 redundant blocks of code with one GOSUB for restoring the grid back to gridCopy. :)
« Last Edit: May 07, 2019, 04:15:15 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Sudoku solver
« Reply #10 on: May 07, 2019, 04:30:42 pm »
 2 in a row! Anyone want to give it a shot? :)
 
Level 8 with one soln.PNG