### Author Topic: Sudoku  (Read 1432 times)

#### B+

• Hero Member
• Posts: 654
##### Sudoku
« on: 11. January 2018, 17:54:51 »
Hi,

I am studying Sudoku Game and probably will revisit Solvers eventually, at these sites:

Just Basic: http://justbasic.conforums.com/index.cgi?board=code&action=display&num=1515342883

SmallBASIC: https://smallbasic.sourceforge.io/?q=node/1773

QB64: http://www.qb64.net/forum/index.php?topic=14672.0

and here The Joyful Programmer > The QB64 Edition:

My main interest is perfecting THE GAME algorithms, board making and cell hiding such that when you hide the cells you don't create a board that can be solved more than one way.

I've already learned you can make a legit board for a game but it is trivial to solve, as discussed or illustrated in above links.

I have devised code that will create non trivial boards but need an algo to hide the cells but keep solution unique, ie only one solution set. Is there one?

Could I understand how it is put together and works? ;-))

#### Rick3137

• Full Member
• Posts: 118
##### Re: Sudoku
« Reply #1 on: 11. January 2018, 18:14:57 »
Hello Mark:

I went through this years ago, and found a nice easy solution.
I start from a solved game, from any source, that works correctly.

I then look at the numbers in the solution, and substitute new numbers for old ones.
For instance; All 1's become 9's. All 2's become 4's, All 9's become 3's etc.
Instant new game.
http://rb23.yolasite.com  Ricks Programs
http://rb27.synthasite.com   Sight and Sound

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #2 on: 11. January 2018, 18:54:48 »
Hi Rick,

Good to see you are still alive and kicking!

Yes! I have started with 6 base board solutions and shuffled columns and rows within boxes and then shuffled vertical or horizontal blocks of boxes and then randomly changed all the numbers as one does with code a = s, b = y, c = f, ....

This leaves a board who's solution is too easy to find because permutation of the same 3 sets of numbers are repeated in every box eg

one box is
148
923
576

so all the other boxes are variations

481
392
657

814
239
765

all you need to see is 18x   and you know x = 4
all you need to see is x4y   and you know x or y = 8 and the other is 4

This is for every box in the puzzle...

hmm... but maybe if you had a better, more random puzzle to start with... yes that would be better!

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #3 on: 14. January 2018, 15:59:51 »
I am pleased to announce that last night I found the formula / recipe to distribute the hidden cells homogeneously throughout the puzzle grid that guarantees leaving each box row, col with a cell which guarantees each cell and row of the whole grid has a 3 cells not hidden (in the hardest level of play that leaves only 3 cells per box.).

My conjecture is that such an arrangement is most likely to keep a puzzle to the original solution devised at the start (which I will explore when I start playing with Solvers again).

Code: [Select]
`' Make #3 Board Test Hiding.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-12'from make #2 Board Maker, now test hiding cells'aha! I have defined levels well for myself at least!randomizedim grid(8, 8) 'global access to use between calls to functions using themwhile 1  cls  'get desired level of difficulty set  locate 6, 27 : ? "Welcome to the game called Sudoku!"  locate 7, 20 : ? "To begin, please enter a level of difficulty."  locate 9, 10 : ? "A level of 1 will hide 1 cell in every box, 4 will hide 4 in every box."  locate 11, 10 : ? "Levels 1 to 3 are good for developing 'flash card' automatic skills."  locate 12, 10 : ? "Levels 4, 5 and 6 are your standard but on easy side for:"  locate 13, 10 : ? "beginner, intermediate, and difficult puzzles."  locate 15, 10  : input "Enter 1 for very easy up to 6 for very hard! any else quits ";level  if level < 0 or level > 10 then end   'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!    'test grids have solutions for Sudoku Game  'while 1  tCount = 0 : tStartOver = 0  makeGrid  showGrid  ? : ? "Grid solve-able ? answer: ";solved()  ? "Total cellBlock redo's ";tCount  ? "      Total StartOvers ";tStartOver  input "OK press enter to see the Hide...";more  hideCells  showGrid  print "That was level ";level  input "Press enter for another set, any else quits ";more  if len(more) then endwendsub hideCells  'global level  local box, cBase, rBase, m, bx, by, dx, dy, dm  for box = 0 to 8    cBase = (box mod 3) * 3    rBase = int(box / 3) * 3    bx = int(rnd*3) : by = int(rnd*3)    dx = int(rnd*2) + 1 : dy = int(rnd*2) + 1     if rnd <.5 then dm = -1 else dm = 1    for m = 0 to level-1      grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0    next  nextend'this will either put the number in the grid's cellBlock or return 0 for failurefunc loadCell(n, cellBlock)  local xoff, yoff, xstop, ystop, list, x, y  local xx, yy, available, i, pointer, cell, r  local wait  'grid  ' 0 1 2  3 4 5  6 7 8  '  'cell block numbers  ' 0 1 2  ' 3 4 5  ' 6 7 8  select case cellBlock    case 0 : xoff = 0 : yoff = 0 : xstop = 0 : ystop = 0    case 1 : xoff = 3 : yoff = 0 : xstop = 2 : ystop = 0    case 2 : xoff = 6 : yoff = 0 : xstop = 5 : ystop = 0    case 3 : xoff = 0 : yoff = 3 : xstop = 0 : ystop = 2    case 4 : xoff = 3 : yoff = 3 : xstop = 2 : ystop = 2    case 5 : xoff = 6 : yoff = 3 : xstop = 5 : ystop = 2    case 6 : xoff = 0 : yoff = 6 : xstop = 0 : ystop = 5    case 7 : xoff = 3 : yoff = 6 : xstop = 2 : ystop = 5    case 8 : xoff = 6 : yoff = 6 : xstop = 5 : ystop = 5  end select  'filling the cells in order so all the ones before n are done  'make a list of free cells in cellblock  dim list(8)  for y = 0 to 2  'make list of cells available    for x = 0 to 2 'find open cell in cellBlock first      if grid(xoff + x, yoff + y) = 0 then 'open        bad = 0        'check rows and columns before this cell block        for yy = 0 to ystop 'rows          if grid(xoff + x,  yy) = n  then            bad = 1            exit for          fi        next        if bad = 0 then          for xx = 0 to xstop            if grid(xx, yoff + y) = n then              bad = 1              exit for            fi          next        fi        if bad = 0 then available++ : list(3*y + x) = 1      end if    next  next  '? : ? "Number of Cells available ";available  'for i = 0 to 8 : ? list(i); : next : ?  'input "OK, press enter... ";wait  'delay 20  if available = 0 then    '? "error: no cells available for: "; n;" in cellBlock ";cellBlock : delay 1500    loadCell = 0    exit func  fi  dim cell(1 to available) : pointer = 1  for i = 0 to 8    if list(i) then cell(pointer) = i : pointer ++  next  'OK our list has cells available to load, pick one randomly  if available > 1 then 'shuffle cells    for i = available to 2 step -1      r = int(rnd * i) + 1      swap cell(i), cell(r)    next  fi  'load the first one listed  grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n  loadCell = 1end'the master sub for which loadCell function was designedsub makeGrid  local n, cellBlock, i, cnt, startOver, temp, wait  'this version requires the assistance of loadCell sub routine  ' debug by stepping through process with showGrid sub  repeat    dim grid(8, 8) : startOver = 0    for n = 1 to 9      temp = grid : cnt = 0      repeat        for cellBlock  = 0 to 8          success = loadCell(n, cellBlock)          if success = 0 then            cnt = cnt + 1            tCount++            if cnt >= 20 then startOver = 1 : tStartOver++ : exit for            grid = temp            exit for          fi          'showGrid          'input  " OK, press enter..."; wait          'delay 200        next        if startOver then exit loop      until success      if startOver then exit for    next  until startOver = 0endsub showGrid  local r, c  cls  for r = 0 to 8    for c = 0 to 8      locate int(r/3) + r + 2 , int(c/3) * 2 + (c + 2) * 3,  : ? grid(c, r)    next  next  ?end' add solved functionfunc solved()  local n, col, row, cell, cellrow, cellcol, found  solved = 0 'n must be found in every column, row and 3x3 cell  FOR n = 1 TO 9    'check columns for n    FOR col = 0 TO 8      found = 0      FOR row = 0 TO 8        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT    'check rows for n    FOR row = 0 TO 8      found = 0      FOR col = 0 TO 8        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT    'check 3x3 cells for n    FOR cell = 0 TO 8      cellcol = cell MOD 3      cellrow = INT(cell / 3)      found = 0      FOR col = 0 TO 2        FOR row = 0 TO 2          IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR        NEXT        IF found = 1 THEN EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT  NEXT  solved = 1end`
4 days to get a dozen lines of code, sheeze!
« Last Edit: 14. January 2018, 19:21:57 by B+ »

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #4 on: 17. January 2018, 20:54:40 »
And here is my most recent update of the Sudoku Game in SmallBASIC version 0.12.11
This uses not so random hiding of cells and levels of play are decided by how many cells per box to remove ie, 0 would display a solved puzzle, 9 would display a board with 0 clues left; easy, intermediate and difficult would be levels: 4, 5 and 6.

Code: [Select]
`' SB1 Sudoku Game.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-17' some edits of game posted 2018-01-17, better quit code with level ' more debug code removed'from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06' add whole new makeGrid (maybe faster) and hideCells code (not so random)'Sudoku Game from SB.bas SmallBASIC 0.12.9 (B+=MGA) 2018-01-04' fix color at start so can see the grid!' add solved function!!! and loop around when solved' removed cell notes, to store in corners randomizeconst TextSize = textwidth("9")const CellSize = TextSize * 5const xMinBoard = CellSizeconst yMinBoard = CellSizeconst xMaxBoard = xMinBoard + 9 * CellSizeconst yMaxBoard = yMinBoard + 9 * CellSizeconst xMidBoard = xMinBoard + (xMaxBoard - xMinBoard)/2const yMidBoard = yMinBoard + (yMaxBoard - yMinBoard)/2const xMinKeyPad = xMinBoard - .5 * CellSizeconst xMaxKeyPad = xMinKeyPad + CellSize * 10const yMinKeyPad = yMaxBoard + 10const yMaxKeyPad = yMinKeyPad + CellSize'main loop sets up game puzzle,'when solved it flashes that fact and then sets up another puzzlewhile 1  'get desired level of difficulty set  cls  LOCATE 5, 5: PRINT "Welcome to SB version of Sudoku Game by bplus"  LOCATE 9, 5: PRINT "To begin, please enter a level of difficulty."  LOCATE 10, 8: PRINT "A level of 1 will hide 1 cell in every box,"  LOCATE 12, 14: PRINT "4 will hide 4 in every box."  LOCATE 14, 9: PRINT "Levels 1 to 3 are good for developing"  LOCATE 15, 12: PRINT "'flash card' automatic skills."  LOCATE 17, 9: PRINT "Levels 4, 5 and 6 are easy standard for:"  LOCATE 18, 5: PRINT "beginner, intermediate, and difficult puzzles."  LOCATE 22, 12: INPUT "Enter 0 to 9 any else quits "; level  IF instr("0123456789", level) then level = val(level) else CLS: END  'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!  'globals  bx = 0 : by = 0  'current highlighted location on board  key = 1          'current key highlighted on keyPad, key = 0 clears cell  update = 1       'when to show game board  dim grid(8,8)    '9x9 board positive values come from puzzle creation  '0 and negative values are cells blanked out to make puzzle  makeGrid  hideCells  'game loop will continue to respond to mouse clicks until puzzle is solved  while solved() = 0    'cls screen display puzzle catch mouse and handle it    if update then showGrid    if pen(3) then      mx = pen(4) : my = pen(5)      while pen(3)        mx = pen(4) : my = pen(5)      wend      'clicked inside Board      if xMinBoard <= mx and mx <= xMaxBoard and yMinBoard <= my and my <= yMaxBoard then        bx = int((mx - xMinBoard)/CellSize) : by = int((my-yMinBoard)/CellSize)        if grid(bx, by) < 1 then          if key = 0 then grid(bx, by) = 0 else grid(bx, by) = -key        fi        update = 1      fi      'clicked inside KeyPad      if xMinKeyPad <= mx and mx <= xMaxKeyPad and yMinKeyPad <= my and my <= yMaxKeyPad then        key = int((mx - xMinKeyPad) / CellSize)        update = 1      fi      if xMidBoard - 3 * CellSize <= mx and mx <= xMidBoard + 3 * CellSize then        if yMaxKeyPad + CellSize <= my and my <= yMaxKeyPad + 2 * CellSize then xit = 1 : exit loop      fi    fi    delay 50  'save fan from running  wend  IF xit THEN    xit = 0  ELSE    BEEP    t = TIMER    WHILE (TIMER - t < 6)      showGrid      DELAY 900      COLOR 15, 0      CLS      at xMidBoard - 7 * TextSize, yMidBoard - .5 * TextSize : ? "Puzzle solved!"      DELAY 300    WEND  END IF wend' add solved functionfunc solved()  local n, col, row, cell, cellrow, cellcol, found  solved = 0 'n must be found in every column, row and 3x3 cell  FOR n = 1 TO 9    'check columns for n    FOR col = 0 TO 8      found = 0      FOR row = 0 TO 8        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT    'check rows for n    FOR row = 0 TO 8      found = 0      FOR col = 0 TO 8        IF abs(grid(col, row)) = n THEN found = 1: EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT    'check 3x3 cells for n    FOR cell = 0 TO 8      cellcol = cell MOD 3      cellrow = INT(cell / 3)      found = 0      FOR col = 0 TO 2        FOR row = 0 TO 2          IF abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n THEN found = 1: EXIT FOR        NEXT        IF found = 1 THEN EXIT FOR      NEXT      IF found = 0 THEN EXIT FUNC    NEXT  NEXT  solved = 1end' displays the game grid, mainly as Chris with more constantssub showGrid()  update = 0 'global calls for this display  local x, y, i, j, b  b = rgb(0, 0, 40)  color 15, b : cls  locate 1, 21 : ? "Sudoku Level ";level  rect xMidBoard - 3 * CellSize, yMaxKeyPad + CellSize, xMidBoard + 3 * CellSize, yMaxKeyPad + 2 * CellSize, 12 filled  at xMidBoard - 2 * TextSize, yMaxKeyPad + CellSize + TextSize + 4  color 7, 12  ? "EXIT"  'draw line segments  i = xMinBoard  for x = 0 to 9    line i,yMinBoard,i,yMaxBoard,13    i += CellSize  next x  j = yMinBoard  for y = 0 to 9    line xMinBoard,j,xMaxBoard,j,13    j += CellSize  next y  'draw heavy 3x3 cell borders  rect xMinBoard+1,yMinBoard+1,xMaxBoard+1,yMaxBoard+1,15  i = xMinBoard+(CellSize*3)+1  line i,yMinBoard,i,yMaxBoard,15  i = xMinBoard+(CellSize*6)+1  line i,yMinBoard,i,yMaxBoard,15  j = yMinBoard+(CellSize*3)+1  line xMinBoard,j,xMaxBoard,j,15  j = yMinBoard+(CellSize*6)+1  line xMinBoard,j,xMaxBoard,j,15  for y = 0 to 8    for x = 0 to 8      'highlite?      if x = bx and y = by then        color b, 10        rect xMinBoard+x*CellSize+3, yMinBoard+y*CellSize+3 step CellSize-5, CellSize-5, 10 filled      else        if grid(x, y) > 0 then color 9, b else color 7, b      end if      if grid(x,y) <> 0 then        at xMinBoard+(x*CellSize)+(TextSize*2), yMinBoard+(y*CellSize)+TextSize+4        ? abs(grid(x,y))      fi    next  next  'show a keypad key with highlite  i = xMinKeyPad  for x = 0 to 9    if x = key then      rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled      color b, 10    else      color 11, b    fi    line i,yMinKeyPad,i,yMaxKeyPad,7    at i+(TextSize*2),yMinKeyPad+TextSize+4    ? x    i += CellSize  next  rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7endfunc loadCell(n, cellBlock)  local xoff, yoff, xstop, ystop, list, x, y  local xx, yy, available, i, pointer, cell, r    xoff = 3 * (cellBlock MOD 3): yoff = 3 * INT(cellBlock / 3)  IF xoff > 0 THEN xstop = xoff - 1 ELSE xstop = 0  IF yoff > 0 THEN ystop = yoff - 1 ELSE ystop = 0  'filling the cells in order so all the ones before n are done  'make a list of free cells in cellblock  dim list(8)  for y = 0 to 2  'make list of cells available    for x = 0 to 2 'find open cell in cellBlock first      if grid(xoff + x, yoff + y) = 0 then 'open        bad = 0        'check rows and columns before this cell block        for yy = 0 to ystop 'rows          if grid(xoff + x,  yy) = n  then            bad = 1            exit for          fi        next        if bad = 0 then          for xx = 0 to xstop            if grid(xx, yoff + y) = n then              bad = 1              exit for            fi          next        fi        if bad = 0 then available++ : list(3*y + x) = 1      end if    next  next  if available = 0 then    loadCell = 0    exit func  fi  dim cell(1 to available) : pointer = 1  for i = 0 to 8    if list(i) then cell(pointer) = i : pointer ++  next  'OK our list has cells available to load, pick one randomly  if available > 1 then 'shuffle cells    for i = available to 2 step -1      r = int(rnd * i) + 1      swap cell(i), cell(r)    next  fi  'load the first one listed  grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n  loadCell = 1endsub makeGrid  local n, cellBlock, i, cnt, startOver, temp, wait  'this version requires the assistance of loadCell sub routine  ' debug by stepping through process with showGrid sub  repeat    dim grid(8, 8) : startOver = 0    for n = 1 to 9      temp = grid : cnt = 0      repeat        for i = 1 to 9          cellBlock = val(mid("013246578", i , 1))          success = loadCell(n, cellBlock)          if success = 0 then            cnt = cnt + 1            if cnt >= 20 then startOver = 1 : exit for            grid = temp            exit for          fi        next        if startOver then exit loop      until success      if startOver then exit for    next  until startOver = 0endsub hideCells  local copyGrid, success, box, cBase, rBase, m, bx, by, dx, dy, dm, test, r, c, i, cnt  copyGrid = grid  while success = 0    for box = 0 to 8      cBase = (box mod 3) * 3      rBase = int(box / 3) * 3      dx = int(rnd*2) + 1 : dy = int(rnd*2) + 1      if rnd <.5 then dm = -1 else dm = 1      bx = int(rnd*3) : by = int(rnd*3)      for m = 0 to level-1        grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0      next    next    showGrid    dim test(9)    for box = 0 to 8      cBase = (box mod 3) * 3      rBase = int(box / 3) * 3      for r = 0 to 2        for c = 0 to 2          test(grid(cBase + c, rBase + r)) = 1        next      next    next    success = 1    for i = 1 to 9      if test(i) = 0 then success = 0    next    if success = 0 then      cnt = cnt + 1      if cnt > 20 then        success = 1 : beep 'when all numbers aren't there      else        grid = copyGrid      fi    fi  wendend`
« Last Edit: 17. January 2018, 20:58:16 by B+ »

#### Rick3137

• Full Member
• Posts: 118
##### Re: Sudoku
« Reply #5 on: 19. January 2018, 16:35:50 »
Nicely done.
http://rb23.yolasite.com  Ricks Programs
http://rb27.synthasite.com   Sight and Sound

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #6 on: 21. January 2018, 01:41:34 »
Thanks Rick!

Here is a fully featured Sudoku App: game, solver and editor. Now make and save puzzles, save a game in progress and come back later to finish. Whatever you can do with mouse you can also do with keyboard and vice versa.

Code: [Select]
`' SB2 Sudoku Game Solver Editor.bas for SmallBASIC 0.12.11 (B+=MGA) 2018-01-20' + A Solver that can do allot of logic to solve, but not all (yet!).' + Puzzle and Make modes, Save and Load temp files, all editable: Temp Saved Puzzle.txt' + Automatic save of solved puzzles: Temp Solved Puzzle.txt' + Temp files created can be read and edited with Notepad' Use OS file manager to save files long term under new names (and/or folders).' + Anything you can do with mouse you can do with keyboard and vice versa.' + ie 6 function Menu'from: SB1 Sudoku Game.bas for SmallBASIC 0.12.11 (B+=MGA) 2018-01-17' + more definitive levels of difficulty and design around them.' + some edits of game posted 2018-01-17, better quit code with level' + more debug code removed, whole sections rewritten.'from: sudoku mod bplus.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-06' add whole new makeGrid (maybe faster) and hideCells code (not so random)'Sudoku Game from SB.bas SmallBASIC 0.12.9 (B+=MGA) 2018-01-04' fix color at start so can see the grid!' add solved function!!! and loop around when solved' removed cell notes, to store in corners optionrandomizeconst TextSize   = textwidth("9")const CellSize   = TextSize * 5const xMinBoard  = CellSizeconst yMinBoard  = CellSizeconst xMaxBoard  = xMinBoard + 9 * CellSizeconst yMaxBoard  = yMinBoard + 9 * CellSizeconst xMidBoard  = xMinBoard + (xMaxBoard - xMinBoard)/2const yMidBoard  = yMinBoard + (yMaxBoard - yMinBoard)/2const xMinKeyPad = xMinBoard - .5 * CellSizeconst xMaxKeyPad = xMinKeyPad + CellSize * 10const yMinKeyPad = yMaxBoard + 10const yMaxKeyPad = yMinKeyPad + CellSizeconst screenWide = 11 * CellSizeconst funcWide   = screenWide / 6const yMinFunc   = yMaxKeyPad + CellSizeconst yMaxFunc   = yMinFunc + CellSize'main loop sets up game puzzle,'when solved it displays that fact and then sets up another puzzlewhile 1  'globals  bx = 0 : by = 0  'current highlighted location on board  key = 1          'current key highlighted on keyPad, key = 0 clears cell  update = 1       'when to show game board  mode = "p"       'mode p for play, mode m for make puzzle  dim grid(8,8)    '9 x 9 board                   '0 value = cell blank, > 0 clues of puzzle, < 0 are guesses  getLevel         'level determines the number of cells removed from each box  makeGrid  hideCells  'game loop will continue to respond to mouse clicks until puzzle is solved  while solved() = 0    'cls screen display puzzle catch mouse and handle it    if update then showGrid    'handlekeypresses should have equivalent mouse actions!    k = inkey    if len(k) = 1 then      update = 1      if k = "h" then        hardSolve      elif k = "m" or k = "p"        mode = k       elif k = "m" then 'convert grid to all positive values        for rrow = 0 to 8          for ccol = 0 to 8            grid(ccol, rrow) = abs(grid(ccol, rrow))          next        next     elif k = "s"       savePZ(0)     elif k = "l"       loadPZ     elif instr("0123456789", k) then       handleNumber k     elif asc(k) = 27       cls : end     else        update = 0     end if    elseif len(k) = 2      update = 1      select case asc(right(k, 1))      case 9  : if by > 0 then by = by - 1 'up arrow      case 10 : if by < 8 then by = by + 1 'down arrow      case 4  : if bx > 0 then bx = bx - 1 'left arrow      case 5  : if bx < 8 then bx = bx + 1 'right arrow      case else : update = 0      end select    end if ' k was something    if pen(3) then  ' caught a mouse down      mx = pen(4) : my = pen(5)      while pen(3)  ' update position until release        mx = pen(4) : my = pen(5)      wend      'clicked inside Board      if xMinBoard <= mx and mx <= xMaxBoard and yMinBoard <= my and my <= yMaxBoard then        bx = int((mx - xMinBoard)/CellSize) : by = int((my-yMinBoard)/CellSize)        handleNumber key      fi      'clicked inside KeyPad      if xMinKeyPad <= mx and mx <= xMaxKeyPad and yMinKeyPad <= my and my <= yMaxKeyPad then        key = int((mx - xMinKeyPad) / CellSize)        update = 1      fi      'clicked inside Func menu: help solve, play mode, make mode, save file, load file, quit screen      if 0 <= mx and mx <= screenWide then        if yMinFunc < my and my < yMaxFunc then          update = 1          xf = mx / funcWide          if xf <= 1 then 'help solve            hardSolve          elif xf <= 2 'play mode            mode = "p"          elif xf <= 3 'make mode            mode = "m"             for rrow = 0 to 8              for ccol = 0 to 8                grid(ccol, rrow) = abs(grid(ccol, rrow))              next            next          elif xf <= 4 'save file            savePZ(0)          elif xf <= 5 'load file            loadPZ          elif xf <= 6 'exit            xit = 1 : exit loop          fi        fi      fi    fi 'if mouse clicked    delay 50  'save fan from running  wend  'did we exit inner game loop because puzzle solved, or quit or get another board?  IF xit THEN xit = 0 ELSE BEEP : savePZ(1) 'signals puzzle solvedwendsub handleNumber(ky)  if grid(bx, by) < 1 or mode = "m"  then 'don't change clues in puzzle mode    if ky = 0 then      grid(bx, by) = 0    else      if aok(ky, bx, by) then 'is this a bad idea = bad key?        if mode = "p" then grid(bx, by) = -ky else grid(bx, by) = ky      else        beep ' bad idea for puzzle mode and make mode      fi    fi  else    beep ' don't change clues!  fi  update = 1endfunc solved() 'has the puzzle been solved? assume solved = 0, exit func once proved  local n, found, col, row, box, cbox, rbox  for n = 1 to 9    'check columns for n    for col = 0 to 8      found = 0      for row = 0 to 8        if abs(grid(col, row)) = n then found = 1 : exit for      next      if found = 0 then exit func    next    'check rows for n    for row = 0 to 8      found = 0      for col = 0 to 8        if abs(grid(col, row)) = n then found = 1: exit for      next      if found = 0 then exit func    next    'check boxes for n    for cell = 0 to 8      cbox = 3 * cell mod 3      rbox = 3 * int(cell / 3)      found = 0      for col = 0 to 2        for row = 0 to 2          if abs(grid(cbox+ col, rbox + row)) = n then found = 1: exit for        next        if found = 1 then exit for      next      if found = 0 then exit func    next  next  solved = 1 'good one!end' displays the game grid, mainly as Chris with more constantssub showGrid()  local x, y, i, j, b, s    update = 0 'before we forget, turn off update global calls for this display  b = rgb(0, 0, 40) 'background color  color 15, b : cls    'title, level mode  if mode = "p" then s = "     Puzzle Mode" else s = "    Make Mode"  ? : cp 1, "Sudoku Level " + level + s    'draw board line segments  i = xMinBoard  for x = 0 to 9    line i, yMinBoard, i, yMaxBoard, 13    i += CellSize  next x  j = yMinBoard  for y = 0 to 9    line xMinBoard, j, xMaxBoard, j, 13    j += CellSize  next y  'draw heavy 3x3 cell borders  rect xMinBoard + 1, yMinBoard + 1, xMaxBoard + 1, yMaxBoard + 1, 15  i = xMinBoard + CellSize * 3 + 1  line i, yMinBoard, i, yMaxBoard, 15  i = xMinBoard + CellSize * 6 + 1  line i, yMinBoard, i, yMaxBoard, 15  j = yMinBoard + CellSize * 3 + 1  line xMinBoard, j, xMaxBoard, j, 15  j = yMinBoard + CellSize * 6 + 1  line xMinBoard, j, xMaxBoard, j, 15  for y = 0 to 8    for x = 0 to 8      'highlite?      if x = bx and y = by then        color b, 10        rect xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3 step CellSize-5, CellSize-5, 10 filled      else        if grid(x, y) > 0 then color 9, b else color 7, b      end if      if grid(x,y) <> 0 then        at xMinBoard + x*CellSize + TextSize*2, yMinBoard + y*CellSize + TextSize + 4        ? abs(grid(x, y))      fi    next  next    'show a keypad key with highlite  i = xMinKeyPad  for x = 0 to 9    if x = key then      rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled      color b, 10    else      color 11, b    fi    line i,yMinKeyPad,i,yMaxKeyPad,7    at i+(TextSize*2),yMinKeyPad+TextSize+4    ? x    i += CellSize  next  rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7    'function pad  'here's where mouse is looking  '    if 0 <= mx and mx <= screenWide then  '      if yMinFunc < my and my < yMaxFunc then  '        xf = my / funcWide  color 11, 12  for i = 1 to 6    rect (i -1)*funcWide + 5, yMinFunc + 5, i * funcWide - 5, yMaxFunc - 5, 12 filled    at  (i -1)*funcWide + 25, yMinFunc + 15    select case i    case 1 : ? "Help"     case 2 : ? "Play"    case 3 : ? "Make"    case 4 : ? "Save"    case 5 : ? "Load"    case 6 : ? "Exit""    end select  next  endsub makeGrid  local n, cellBlock, i, cnt, startOver, temp, wait  'this version requires the assistance of loadCell sub routine  ' debug by stepping through process with showGrid sub  repeat    dim grid(8, 8) : startOver = 0    for n = 1 to 9      temp = grid : cnt = 0      repeat        for box= 0 to 8          success = loadBox(n, box)          if success = 0 then            cnt = cnt + 1            if cnt >= 20 then startOver = 1 : exit for            grid = temp            exit for          fi        next        if startOver then exit loop      until success      if startOver then exit for    next  until startOver = 0endsub hideCells  local box, cBase, rBase, m, bx, by, dx, dy, dm    for box = 0 to 8      cBase = (box mod 3) * 3      rBase = int(box / 3) * 3      dx = int(rnd * 2) + 1 : dy = int(rnd * 2) + 1      if rnd < .5 then dm = -1 else dm = 1      bx = int(rnd * 3) : by = int(rnd * 3)      for m = 0 to level - 1        grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0      next    nextendfunc aok(a, c, r) 'check to see if a is OK to place at (c, r)  local i, rr, cc, cbase, rbase  aok = 0  if grid(c, r) = 0 then 'check cell empty     for i = 0 to 8 'check row and column       if abs(grid(i, r)) = a or abs(grid(c, i)) = a then exit func     next     'cbase = int(c / 3) * 3 : rbase = int(r / 3) * 3     cbase = c - c mod 3 : rbase = r - r mod 3     for rr = 0 to 2        for cc = 0 to 2           if abs(grid(cbase + cc, rbase + rr)) = a then exit func        next     next     aok = 1  fiendfunc loadBox(n, box) 'this one uses aok function to help load boxes  local xoff, yoff, list, x, y, available, i, pointer, cell, r    xoff = 3 * (box mod 3) : yoff = 3 * int(box / 3)  'make a list of free cells in cellblock  dim list(8)  for y = 0 to 2  'make list of cells available    for x = 0 to 2 'find open cell in cellBlock first        if aok(n, xoff + x, yoff + y) then available++ : list(3 * y + x) = 1    next  next  if available = 0 then    exit func  fi  dim cell(1 to available) : pointer = 1  for i = 0 to 8    if list(i) then cell(pointer) = i : pointer ++  next  'OK our list has cells available to load, pick one randomly  if available > 1 then 'shuffle cells    for i = available to 2 step -1      r = int(rnd * i) + 1      swap cell(i), cell(r)    next  fi  'load the first one listed  grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n  loadBox = 1endfunc sweepChange()  'global grid, update  local n, c, r, only, nn, b1, b2, b3, b4, cbase, rbase, rr, cc    for n = 1 to 9    for r = 0 to 8      for c = 0 to 8        if aok(n, c, r) then          cbase = 3 * int(c / 3) : rbase = 3 * int(r /3) 'used in a couple of tests          'only n is good at c, r ?          only = 1          for nn = 1 to 9            if nn <> n then              if aok(nn, c, r) then only = 0 : exit for              'no other n works at            fi          next          if only then            grid(c, r) = -n : sweepChange = 1 : update = 1 : exit for          fi        fi 'if aok(n, c, r)      next c    next r  next nendsub hardSolve()  local continue    continue = boxCheck  while continue    showGrid    delay 1000    continue = boxCheck    if continue = 0 then continue = sweepChange() 'a 2nd solver method  wend  beependsub savePZ(saveSolved)  local fName, r, s, c  showGrid  if saveSolved then fName = "Temp Solved Puzzle.txt" else fName = "Temp Saved Puzzle.txt"  open fName for output as #1  for r = 0 to 8    s = ""    for c = 0 to 8      s = s + right("   " + str(grid(c, r)), 3)    next    print #1, s;Chr(13) 'not 13 and 10 and not 10 so 13! yes!  next  close #1  color 9, 11  locate 26, 3 : ? " *** Puzzle saved to: " + fName + " *** "  delay 5500endsub loadPZ()  local fl, row, i, n    open "Temp Saved Puzzle.txt" for input as #1  for row = 0 to 8    input #1, fl    for i = 0 to 8      n = val(mid(fl, 3 * i + 1, 3))      grid(i, row) = n    next  next  close #1endfunc boxCheck() 'return 0 if no changes made, else return 1  local n, box, xoff, yoff, list, x, y, available, theCell  for n = 1 to 9    for box = 0 to 8      available = 0      xoff = 3 * (box MOD 3): yoff = 3 * INT(box / 3)      'save last free cells in box, if only one the      for y = 0 to 2  'make list of cells available        for x = 0 to 2 'find open cell in cellBlock first          if aok(n, xoff + x, yoff + y) then 'count available            available++ : theCell = 3 * y + x          end if        next      next      'if there is only one place n works in box put it there!      if available = 1 then        boxCheck = 1 'flag a change        grid(xoff + (theCell mod 3), yoff + int(theCell / 3)) = -n      fi    next  nextendsub getLevel  'isolated to work on independently  'get desired level of difficulty set  color 15, 0: cls  rect 0, 0, screenwide, yMaxFunc, 8   cp 2,  "Sudoku Game, Solver and Editor by bplus"  cp 4, "While running a puzzle try pressing h key for help."  cp 5, "It will logically solve puzzle as far as it can,"  cp 6, "then beep to let you know it's finished."  cp 7, "(A double beep would mean it's finished and solved.)"  cp 9, "To begin, please enter a level of difficulty."  cp 10, "A level of 1 will hide 1 cell in every box,"  cp 11, "4 will hide 4 in every box."  cp 12, "Levels 1 to 3 are good for developing"  cp 13, "'flash card' automatic skills."  cp 14, "Levels 4, 5 and 6 are easy standard for:"  cp 15, "beginner, intermediate, and difficult puzzles."  cp 17, "Use level 9 to blank a puzzle and input your own."  lp 2, "press m for Make mode (enters pos values in grid)."  lp 2, "press p for Puzzle mode (enters neg values in grid)."  lp 2, "Press s for save, files to Temp Saved Puzzle.txt"  lp 2, "press l to load that puzzle up again."  cp 22, "When a puzzle is Solved it is automatically saved"  cp 23, "to Temp Solved Puzzle.txt"   cp 24, "Use your OS to manage these files."  color 14, 0  LOCATE 27, 1: INPUT "Now about the level? Enter 0 to 9 any else quits "; level  IF instr("0123456789", level) then level = val(level) else CLS: stop  'test robustness of algo for hiding should work to hiding 9 cells in box! YES!!!endsub cp(cpRow, text)  at (screenWide - txtw(text))/2, cpRow * txth(text)   ? text  endsub lp(spacer, text)  ? space(spacer);textend`

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #7 on: 21. January 2018, 09:18:23 »
Oh hey!

Code: [Select]
`sub ps(x, y, size, s) ' a sub to make translating to SmallBASIC from SdlBasic easier  'when this sub is used text size is altered for the rest of the run  local l  l.w = window() : l.w.setfont(size, "pt", 0, 0)  at x, y : ? s  l.w.setfont(18, "pt", 0, 0)end `
to remake this:
Code: [Select]
`' displays the game grid, mainly as Chris with more constantssub showGrid()  local x, y, i, j, b, s, cell, n, cs    update = 0 'before we forget, turn off update global calls for this display    b = rgb(0, 0, 40) 'background color  color 15, b : cls    'title, level mode  if mode = "p" then s = "     Puzzle Mode" else s = "    Make Mode"  ? : cp 1, "Sudoku Level " + level + s    'draw board line segments  i = xMinBoard  for x = 0 to 9    line i, yMinBoard, i, yMaxBoard, 13    i += CellSize  next x  j = yMinBoard  for y = 0 to 9    line xMinBoard, j, xMaxBoard, j, 13    j += CellSize  next y  'draw heavy 3x3 cell borders  rect xMinBoard + 1, yMinBoard + 1, xMaxBoard + 1, yMaxBoard + 1, 15  i = xMinBoard + CellSize * 3 + 1  line i, yMinBoard, i, yMaxBoard, 15  i = xMinBoard + CellSize * 6 + 1  line i, yMinBoard, i, yMaxBoard, 15  j = yMinBoard + CellSize * 3 + 1  line xMinBoard, j, xMaxBoard, j, 15  j = yMinBoard + CellSize * 6 + 1  line xMinBoard, j, xMaxBoard, j, 15  for y = 0 to 8    for x = 0 to 8      'make a string of available candidates for cell      cs = ""      for n = 1 to 9        if aok(n, x, y) then cs = cs + str(n)      next            'highlite?      if x = bx and y = by then        color b, 10        rect xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3 step CellSize-5, CellSize-5, 10 filled      else        if grid(x, y) > 0 then color 9, b else color 7, b      end if      if grid(x,y) <> 0 then        ps xMinBoard + x*CellSize + TextSize*2, yMinBoard + y*CellSize + TextSize + 4, 26, abs(grid(x, y))      else        ps xMinBoard + x*CellSize + 3, yMinBoard + y*CellSize + 3, 12, cs      fi    next  next    'show a keypad key with highlite  i = xMinKeyPad  for x = 0 to 9    if x = key then      rect i+3,yMinKeyPad+3 step CellSize-5, CellSize-5, 10 filled      color b, 10    else      color 11, b    fi    line i,yMinKeyPad,i,yMaxKeyPad,7    at i+(TextSize*2),yMinKeyPad+TextSize+4    ? x    i += CellSize  next  rect xMinKeyPad, yMinKeyPad, xMaxKeyPad, yMaxKeyPad, 7    'function pad  'here's where mouse is looking  '    if 0 <= mx and mx <= screenWide then  '      if yMinFunc < my and my < yMaxFunc then  '        xf = my / funcWide  color 11, 12  for i = 1 to 6    rect (i -1)*funcWide + 5, yMinFunc + 5, i * funcWide - 5, yMaxFunc - 5, 12 filled    at  (i -1)*funcWide + 25, yMinFunc + 15    select case i    case 1 : ? "Help"     case 2 : ? "Play"    case 3 : ? "Make"    case 4 : ? "Save"    case 5 : ? "Load"    case 6 : ? "Exit""    end select  next  end`
and get this! (note: the puzzle is NOT level 6 but an Intermediate I made, saved and loaded, copied from newspaper)
« Last Edit: 21. January 2018, 09:21:38 by B+ »

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #8 on: 21. January 2018, 20:36:43 »
Sudoku Solver Starter in JB Mainwin:
Code: [Select]
`'Sudoku Solve Experiment.bas for JB v2.0 b 2018-01-21 (B+=MGA)' experiment with another Solver after reading Sudoku.org.uk discussion with code in JS'recursive Solver? who needs that? ;-))  I do! For Solvers that handle ambiguity.'A solver starter... Level 4 OK, level 5 very shakey, level 6 doubt it!'globalsglobal leveldim grid(8, 8), copy(8, 8), copy2(8, 8)lastPuzzle = 3  '3 puzzles to read through datawhile 1    scan    puzzle = puzzle + 1    if puzzle <= lastPuzzle then 'read in puzzle        read puzzleSource\$        for row = 0 to 8            for col = 0 to 8                read digit                grid(col, row) = digit                copy2(col, row) = digit            next        next    else  'make up a puzzle now!        cls        call cp 5, "*** Puzzle Maker for Sudoku ***"        call cp 7, "To begin, please enter a level of difficulty."        call cp 9, "A level of 1 will hide 1 cell in every box,"        call cp 10, "4 will hide 4 in every box."        call cp 12, "Levels 1 to 3 are good for developing"        call cp 13, "'flash card' automatic skills."        call cp 15, "Levels 4, 5 and 6 are easy standard for:"        call cp 16, "beginner, intermediate, and difficult puzzles."        call cp 18, "Enter a level 0 to 9, any other to quits. "        locate 40, 19 : input " "; quit\$        if quit\$ <> "" then            if instr("0123456789", quit\$) then level = val(quit\$) else print : print space\$(35);"Goodbye!" : end        else            print : print space\$(35);"Goodbye!" : end        end if        puzzleSource\$ = "Puzzle #";puzzle;" provided hot off the press by bplus code for puzzle making!."        call makeGrid        call hideCells        call copyGrid2    end if    'attempt to solve it    result = CompleteGrid()    if 0 < result and result < 65 then        s\$ = "solved in ";result;" rounds!"    else        if 0 > result then            s\$ = "Puzzle failed to change after round ";-1 * result;"."        else            s\$ = "Went full ";result - 1;" rounds and still incomplete! (not likely to see this report)"        end if    end if    'show off    cls    print puzzleSource\$    for row = 0 to 8  'how far did we get?        for col = 0 to 8            locate col * 3 + 1, row + 3  : print right\$("   ";copy2(col, row), 3);            locate col * 3 + 30, row + 3 : print right\$("   ";grid(col, row), 3);        next        print    next    print : print "CompleteGrid function reports: ";s\$    print    input "Press enter for next puzzle."; LookSee\$wend' Puzzle Making  ================================================function loadBox(n, box)    'this one uses aok function to help load boxes    xoff = 3 * (box mod 3) : yoff = 3 * int(box / 3)    'make a list of free cells in cellblock    dim list(8)    for y = 0 to 2  'make list of cells available        for x = 0 to 2 'find open cell in cellBlock first            if aok(n, xoff + x, yoff + y) then available = available + 1 : list(3 * y + x) = 1        next    next    if available = 0 then exit function    dim cell(available) : pointer = 1    for i = 0 to 8        if list(i) then cell(pointer) = i : pointer = pointer + 1    next    'OK our list has cells available to load, pick one randomly    if available > 1 then 'shuffle cells        for i = available to 2 step -1            r = int(rnd(0) * i) + 1            t = cell(i) : cell(i) = cell(r) : cell(r) = t        next    end if    'load the first one listed    grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n    loadBox = 1 ' we are goldenend functionsub copyGrid    for r = 0 to 8        for c = 0 to 8            scan            copy(r, c) = grid(r, c)        next    nextend subsub copyCopy    for r = 0 to 8        for c = 0 to 8            scan            grid(r, c) = copy(r, c)        next    nextend subsub copyGrid2    for r = 0 to 8        for c = 0 to 8            scan            copy2(r, c) = grid(r, c)        next    nextend subsub makeGrid    'this version requires the assistance of LoadBox function and subs copyGrid, copyCopy    do        scan        redim grid(8, 8) : startOver = 0        for n = 1 to 9            scan            call copyGrid            cnt = 0            do                scan                for box = 0 to 8                    scan                    success = loadBox(n, box)                    if success = 0 then                        cnt = cnt + 1                        if cnt >= 20 then startOver = 1 : exit for                        call copyCopy                        exit for                    end if                next                if startOver then exit do            loop until success            if startOver then exit for        next    loop until startOver = 0end subsub hideCells    for box = 0 to 8        scan        cBase = (box mod 3) * 3        rBase = int(box / 3) * 3        dx = int(rnd(0) * 2) + 1 : dy = int(rnd(0) * 2) + 1        if  rnd(0) < .5 then dm = -1 else dm = 1        bx = int(rnd(0) * 3) : by = int(rnd(0) * 3)        for m = 0 to level - 1            scan            grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0        next    nextend subfunction aok(a, c, r) 'check to see if a is OK to place at (c, r)  if grid(c, r) = 0 then 'check cell empty     for i = 0 to 8 'check row and column for n       if abs(grid(i, r)) = a or abs(grid(c, i)) = a then exit function     next     cbase = c - c mod 3 : rbase = r - r mod 3 'check box for n     for rr = 0 to 2        for cc = 0 to 2           if abs(grid(cbase + cc, rbase + rr)) = a then exit function        next     next     aok = 1  'otherwise function will return 0 on exit  end ifend function'======== end of Grid Making stuff, Start of Solver stuff, aok(a, c, r) used with both!function CompleteGrid()  'by trying to Solve it    for round = 1 to 65 '17 clues from 81 cells = 64 maximum rounds to make, add 1 for good measure        NoChange = 1  'no sense waiting in suspense if nothing is getting changed in puzzle        gridIsDone = 1        for n = 1 to 9            for r = 0 to 8                for c = 0 to 8                    scan                    if aok(n, c, r) then ' (c, r) is empty and n works there                        gridIsDone = 0  'still a space left in grid                        'is n the only number that works here in row?                        only = 1  'only n works here                        for nn = 1 to 9                            scan                            if nn <> n then                                if aok(nn, c, r) then only = 0 : exit for                            end if                        next                        if only then                            grid(c, r) = -1 * n  'ID fill-ins with neg numbers to tell from clues                            NoChange = 0                        end if                    end if 'Grid = 0                next            next        next        if gridIsDone then            CompleteGrid = round 'successful completion in round numbers            exit function        else            if NoChange then 'bug out!                CompleteGrid = -1 * round                exit function            end if        end if    next    CompleteGrid = round 'last round still failed to completeend functionsub cp row, ps\$    locate (80-len(ps\$))/2, row : print ps\$end subdata "puzzle test 1 from Sudoku.org.uk tutorial in JS using recursive technique"' (which I couldn't get a proper translation to work!)data 0, 0, 0, 7, 0, 8, 0, 3, 0data 0, 0, 0, 2, 4, 0, 9, 1, 0data 0, 0, 4, 0, 9, 0, 0, 7, 8data 4, 0, 0, 3, 5, 0, 0, 0, 2data 0, 0, 2, 1, 6, 4, 7, 0, 0data 9, 0, 0, 0, 0, 0, 3, 0, 0data 6, 4, 9, 0, 0, 1, 0, 2, 3data 0, 0, 0, 9, 0, 0, 5, 0, 0data 3, 7, 0, 0, 8, 0, 0, 0, 1data "puzzle test 2 from PD 2018-01-19 Level 4 (Most difficult!)"' OK THAT WAS TOO HARD! not a single cell resolved!data  0,  9,  0,  4,  0,  2,  0,  0,  0data  0,  4,  0,  0,  9,  0,  2,  0,  0data  0,  3,  0,  0,  0,  8,  0,  7,  4data  0,  0,  8,  0,  6,  0,  0,  0,  0data  2,  0,  0,  9,  0,  1,  0,  0,  8data  0,  0,  0,  0,  0,  0,  6,  0,  0data  3,  7,  0,  8,  0,  0,  0,  2,  0data  0,  0,  6,  0,  3,  0,  0,  8,  0data  0,  0,  0,  5,  0,  9,  0,  3,  0data "puzzle test 3 from PD 2018-01-18 Level Intermediate"' well solver didn't get too far with that one either, but got a couple...data  0,  0,  0,  0,  8,  0,  0,  0,  0data  9,  5,  1,  0,  0,  0,  6,  0,  0data  0,  0,  7,  5,  4,  0,  0,  9,  0data  0,  0,  0,  0,  0,  0,  0,  2,  0data  0,  0,  0,  0,  5,  4,  7,  0,  0data  0,  9,  0,  2,  0,  0,  0,  0,  3data  0,  0,  0,  0,  0,  0,  4,  8,  0data  3,  0,  0,  0,  0,  0,  0,  0,  2data  4,  0,  0,  7,  9,  0,  5,  0,  0`

No lines or circles, no color,...   just a large scrolling screen and brains!  ;-))
« Last Edit: 21. January 2018, 20:46:08 by B+ »

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #9 on: 22. January 2018, 03:23:26 »
Oh hey! This recursive Solver from JB forum kicks butt!
Code: [Select]
`'Sudoku Recursive Solve Experiment.bas for JB v2.0 b 2018-01-21 (B+=MGA)' ============================================= check out'  Sukoku solver program'  version 2'  resolve sub written by cassiope01 on 18 Nov 2011'  modified very slightly by TyCamden on 19 Nov 2011' modified more by me for testing code here' === >>> works way way way better than my starter!' It is very much like the JS code I was looking at.global leveldim grid(8, 8), copy(8, 8), copy2(8, 8)'3 puzzles to read through data easy, very hard and Intermediate with unique solutionslastPuzzle = 3while 1    scan    puzzle = puzzle + 1    if puzzle <= lastPuzzle then 'read in puzzle        read puzzleSource\$        for row = 0 to 8            for col = 0 to 8                read digit                grid(col, row) = digit                copy2(col, row) = digit            next        next    else  'make up a puzzle now!        cls        call cp 5, "*** Puzzle Maker for Sudoku ***"        call cp 7, "To begin, please enter a level of difficulty."        call cp 9, "A level of 1 will hide 1 cell in every box,"        call cp 10, "4 will hide 4 in every box."        call cp 12, "Levels 1 to 3 are good for developing"        call cp 13, "'flash card' automatic skills."        call cp 15, "Levels 4, 5 and 6 are easy standard for:"        call cp 16, "beginner, intermediate, and difficult puzzles."        call cp 18, "Enter a level 0 to 9, any other to quits. "        locate 40, 19 : input " "; quit\$        if quit\$ <> "" then            if instr("0123456789", quit\$) then level = val(quit\$) else print : print space\$(35);"Goodbye!" : end        else            print : print space\$(35);"Goodbye!" : end        end if        puzzleSource\$ = "Puzzle #";puzzle;" provided hot off the press by bplus code for puzzle making!."        call makeGrid        call hideCells        call copyGrid2    end if    'attempt to solve and test results independent of resolve    call resolve    s\$ = "An independent test of the grid() array reports it "    if solved() then s\$ = s\$;"solved!" else s\$ = s\$;"NOT solved."    'report    cls    print puzzleSource\$    for row = 0 to 8  'how far did we get?        for col = 0 to 8            locate col * 3 + 1, row + 3  : print right\$("   ";copy2(col, row), 3);            locate col * 3 + 30, row + 3 : print right\$("   ";grid(col, row), 3);        next        print    next    print : print s\$    print : input "Press enter for next puzzle."; LookSee\$wend' Puzzle Making  ===================function loadBox(n, box)    'this one uses aok function to help load boxes    xoff = 3 * (box mod 3) : yoff = 3 * int(box / 3)    'make a list of free cells in cellblock    dim list(8)    for y = 0 to 2  'make list of cells available        for x = 0 to 2 'find open cell in cellBlock first            if aok(n, xoff + x, yoff + y) then available = available + 1 : list(3 * y + x) = 1        next    next    if available = 0 then exit function    dim cell(available) : pointer = 1    for i = 0 to 8        if list(i) then cell(pointer) = i : pointer = pointer + 1    next    'OK our list has cells available to load, pick one randomly    if available > 1 then 'shuffle cells        for i = available to 2 step -1            r = int(rnd(0) * i) + 1            t = cell(i) : cell(i) = cell(r) : cell(r) = t        next    end if    'load the first one listed    grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n    loadBox = 1 ' we are goldenend functionsub copyGrid    for r = 0 to 8        for c = 0 to 8            copy(r, c) = grid(r, c)        next    nextend subsub copyCopy    for r = 0 to 8        for c = 0 to 8            grid(r, c) = copy(r, c)        next    nextend subsub copyGrid2    for r = 0 to 8        for c = 0 to 8            copy2(r, c) = grid(r, c)        next    nextend subsub makeGrid    'this version requires the assistance of LoadBox function and subs copyGrid, copyCopy    do        redim grid(8, 8) : startOver = 0        for n = 1 to 9            call copyGrid            cnt = 0            do                for box = 0 to 8                    success = loadBox(n, box)                    if success = 0 then                        cnt = cnt + 1                        if cnt >= 20 then startOver = 1 : exit for                        call copyCopy                        exit for                    end if                next                if startOver then exit do            loop until success            if startOver then exit for        next    loop until startOver = 0end subsub hideCells    for box = 0 to 8        scan        cBase = (box mod 3) * 3        rBase = int(box / 3) * 3        dx = int(rnd(0) * 2) + 1 : dy = int(rnd(0) * 2) + 1        if  rnd(0) < .5 then dm = -1 else dm = 1        bx = int(rnd(0) * 3) : by = int(rnd(0) * 3)        for m = 0 to level - 1            scan            grid(cBase + ((bx + m * dx) mod 3) , rBase + (by + m * dy + int(m/3) * dm) mod 3) = 0        next    nextend sub' the following sub is reused over and over, making a grid and solving one and checking player's choices' It is even used in the recursive sub written by cassiope01 on 18 Nov 2011function aok(a, c, r) 'check to see if a is OK to place at (c, r)  if grid(c, r) = 0 then 'check cell empty     for i = 0 to 8 'check row and column for n       if abs(grid(i, r)) = a or abs(grid(c, i)) = a then exit function     next     cbase = c - c mod 3 : rbase = r - r mod 3 'check box for n     for rr = 0 to 2        for cc = 0 to 2           if abs(grid(cbase + cc, rbase + rr)) = a then exit function        next     next     aok = 1  'otherwise function will return 0 on exit  end ifend function' = WOW this would be sweet if it works!'change cell() to grid(), 0 to 8 not 1 to 9 for cells in grid()'use aok() function in place of ok() as it does the same thing without string processing    sub resolve        for yy = 0 to 8            for xx = 0 to 8                scan 'added scan                if grid(xx,yy) = 0 then                    for nb = 1 to 9                        if aok(nb,xx,yy) then                            nbre.tamp = grid(xx,yy)                            grid(xx,yy) = nb                            call resolve                            scan                            if grille.finie() then exit sub                            grid(xx,yy) = nbre.tamp                        end if                    next                    exit sub                end if            next        next    end sub    Function grille.finie()  'grid finished ?        grille.finie = 1        for yy = 0 to 8            for xx = 0 to 8                if grid(xx,yy) = 0 then                    grille.finie = 0 :exit function                end if            next        next    end function' check a grid is playable (or solved), independent checkfunction solved()    solved = 0 'n must be found in every column, row and 3x3 cell    for n = 1 to 9        'check columns for n        for col = 0 to 8            found = 0            for row = 0 to 8                if abs(grid(col, row)) = n then found = 1: exit for            next            if found = 0 then exit function        next        'check rows for n        for row = 0 to 8            found = 0            for col = 0 to 8                if abs(grid(col, row)) = n then found = 1: exit for            next            if found = 0 then exit function        next        'check 3x3 cells for n        for cell = 0 to 8            cellcol = cell mod 3            cellrow = int(cell / 3)            found = 0            for col = 0 to 2                for row = 0 to 2                if abs(grid(cellcol * 3 + col, cellrow * 3 + row)) = n then found = 1: exit for                next                if found = 1 then exit for            next            if found = 0 then exit function        next    next    solved = 1end functionsub cp row, ps\$    locate (80-len(ps\$))/2, row : print ps\$end subdata "puzzle test 1 from Sudoku.org.uk tutorial in JS using recursive technique"' (which I couldn't get a proper translation to work!)data 0, 0, 0, 7, 0, 8, 0, 3, 0data 0, 0, 0, 2, 4, 0, 9, 1, 0data 0, 0, 4, 0, 9, 0, 0, 7, 8data 4, 0, 0, 3, 5, 0, 0, 0, 2data 0, 0, 2, 1, 6, 4, 7, 0, 0data 9, 0, 0, 0, 0, 0, 3, 0, 0data 6, 4, 9, 0, 0, 1, 0, 2, 3data 0, 0, 0, 9, 0, 0, 5, 0, 0data 3, 7, 0, 0, 8, 0, 0, 0, 1data "puzzle test 2 from PD 2018-01-19 Level 4 (Most difficult!)"' OK THAT WAS TOO HARD! not a single cell resolved!data  0,  9,  0,  4,  0,  2,  0,  0,  0data  0,  4,  0,  0,  9,  0,  2,  0,  0data  0,  3,  0,  0,  0,  8,  0,  7,  4data  0,  0,  8,  0,  6,  0,  0,  0,  0data  2,  0,  0,  9,  0,  1,  0,  0,  8data  0,  0,  0,  0,  0,  0,  6,  0,  0data  3,  7,  0,  8,  0,  0,  0,  2,  0data  0,  0,  6,  0,  3,  0,  0,  8,  0data  0,  0,  0,  5,  0,  9,  0,  3,  0data "puzzle test 3 from PD 2018-01-18 Level Intermediate"' well solver didn't get too far with that one either, but got a couple...data  0,  0,  0,  0,  8,  0,  0,  0,  0data  9,  5,  1,  0,  0,  0,  6,  0,  0data  0,  0,  7,  5,  4,  0,  0,  9,  0data  0,  0,  0,  0,  0,  0,  0,  2,  0data  0,  0,  0,  0,  5,  4,  7,  0,  0data  0,  9,  0,  2,  0,  0,  0,  0,  3data  0,  0,  0,  0,  0,  0,  4,  8,  0data  3,  0,  0,  0,  0,  0,  0,  0,  2data  4,  0,  0,  7,  9,  0,  5,  0,  0`
The less the clues the faster it "solves" or resolves the puzzle board.

Here is snap of the hardest puzzle I have recorded in data:

Update: Does not work well in SmallBASIC, stack overload errors after a certain level of recursion, QB64 solves puzzles instantly with it!
« Last Edit: 22. January 2018, 06:29:52 by B+ »

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #10 on: 24. January 2018, 03:35:29 »
OK here is fully featured Sudoku App with nice recursive solver, outstanding Help that can be toggled on/off, what you can do with keyboard you can do with mouse and vice versa (except get level in opening screen).

Well here are a couple of screen shots:

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #11 on: 24. January 2018, 03:38:13 »
Oh but we need to see the important ones with Help and Fill (Solve):

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #12 on: 24. January 2018, 03:40:16 »
Oh the QB64 v1.1 20171106/82 source file:
« Last Edit: 24. January 2018, 22:08:20 by B+ »

#### B+

• Hero Member
• Posts: 654
##### Re: Sudoku
« Reply #13 on: 24. January 2018, 22:07:32 »
Oops! number key press was not being entered into grid as negative thus causing the numbers to act as clues and not guesses.

Fixed in QB3_1 Sudoku App.zip in post above.