Sudoku

Hi,

I am studying the Sudoku Game.

Yes, I know Chris has left a very nice game in Code Library but qbguy presented a game at QB64.net that I liked very much and wanted to figure out why!

From the beginning I liked the way qbguy hid his cells. Chris version is random and so games could get multiple solutions ie you can never solve logically all the cells, at some point you have to plug-in cell values in order to finish a puzzle. Of course some plug-ins are better than others and that is part of the Game too... But qbguys code had same problem, the hiding cells method creates multiple solutions. But qbguys dispersion of blank cells seems better, more evenly spread out... still working on this quality of the Game.

So last night I finally figured out the main reason why I liked qbguys puzzles so much. They have an underlining pattern that makes them almost trivial to solve ONCE YOU FIGURE OUT THE PATTERN! We won t say how long I ve been playing with the puzzles before I finally figured out the pattern. I had been working on alternate board making algos and discovered my first board maker had the same fatal flaw of the underlining pattern that makes solving the games trivial (once you figure out the pattern).

Here is the code for that first board maker study, so maybe you can see the problem of making a game trivial to solve:

' Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-07

'I don't know if this offers real variety??

dim grid(8, 8) 'global access

'test grids have solutions for Sudoku Game
while 1
makeGrid
showGrid
? : ? "Grid solve-able ? answer: ";solved()
input "Press enter for another, any else quits ";more
if len(more) then end
wend

sub
makeGrid
' create a playable Sudoku grid and then swap rows, columns or cell blocks
' any of 1 to 9 digits could end up in any grid(x, y) position

local rIncrement, col, row, starter, slider
local i, j, swapMode, cellSet, rc1, rc2
local ta 'temp array

'to understand the following need diagram
'147:258:369
'258:369:471
'369:471:582
'471:582:693
'582:693:714
'693:714:825
'714:825:936
'825:936:147
'936:147:258
'then I accidently discovered increment 1 (above) 2, 4, 5, 7, 8 all work for same starter!

repeat 'choose from 6 setup boards
rIncrement = Int(rnd * 8) + 1
until rIncrement <> 3 and rIncrement <> 6

for col = 0 to 8
if starter = 0
starter = 1
elif starter = 7
starter = 2
elif starter = 8
starter = 3
else
starter = starter + 3
fi
slider = starter
for row = 0 to 8
grid(col, row) = slider
slider = slider + rIncrement
if slider > 9 then slider = slider mod 9
next
next

'potentialy shuffling 9 rows, 9 cols, 3 vertical cell blocks or 3 horizontals
for i = 0 to 23
swapMode = int(rnd * 24)
cellSet = int(rnd * 3) ' first, second, third
rc1 = int(rnd * 3) ' 0, 1, 2
repeat
rc2 = int(rnd * 3) ' to swap with rc1 0, 1, 2 Not = rc1
until rc2 <> rc1
for slider = 0 to 8 ' reusing a variable
if swapMode < 9 then ' swap rows
swap grid(slider, cellSet * 3 + rc1), grid(slider, cellSet * 3 + rc2)
elif swapMode < 18 ' swap columns
swap grid(cellSet * 3 + rc1, slider), grid(cellSet * 3 + rc2, slider)
elif swapMode < 21 ' swap cell block rows
for j = 0 to 2
swap grid(slider, rc1*3 + j), grid(slider, rc2*3 + j)
next
elif swapMode < 24 ' swap cell block columns
for j = 0 to 2
swap grid(rc1*3 + j, slider), grid(rc2*3 + j, slider)
next
fi
next
next

'for 9! permutations of number substitutes or codes
'OK code the numbers st 1 is made another number 1-9, 2...
dim ta(1 to 9)
for i = 1 to 9 : ta(i) = i : next
for i = 9 to 2 step -1 'shuffle
swap ta(i), ta(int(rnd*i) + 1)
next
for col = 0 to 8
for row = 0 to 8
grid(col, row) = ta( grid(col, row))
next
next
end

sub
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 function
func 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 = 1
end



Notice, I have employed a Solved Function so the Game will acknowledge a successful solution, shoot off fireworks (or some other flashy signal of solving the puzzle) and then offer you another game because, of course, you will want to play again, then! I have added that to Chris game but I wanted to study the hiding cell dispersion problem before I presented the Game in it's more perfected state in SmallBASIC.

No! A solver you say? No! A pattern? I almost break my brain trying to figure out these things and now you have taken away the pain and struggle... COOL... A job well done. I cannot pretend to know how this beastie works but I'm glad it does!! Well done, sir! Well done!

J

ps: You mentioned 'fireworks', and as such, I was expecting the incorporation of a particle system... Now THAT would have been 'icing on the cake'... Nudge. Nudge. Wink. Wink. lol

Hi J,

I hope you understand the code posted above is just code for making and testing a Sudoku Game board, that's it!

And it makes trivially easy to solve Game Boards, it's an example of what I don't want in my top quality SmallBASIC Sudoku Game.

As to fireworks, there is this:
http://qb64.thejoyfulprogrammer.com/showthread.php?tid=1200&pid=5690&rnd...

I don't know if SmallBASIC interprets code fast enough to run a translated version, I am guessing not which is why I hadn't translated it.

It would also help if I could draw on top of an image which I don't think I can in SmallBASIC.

Cool fireworks! Reflection as well. Impressive. It's very 'busy' and caused a slight flicker running it on qb64 but still impressive. I think even sdlbasic would probably struggle with that one as well... (you will probably guess that I may try and convert it don't you? lol)

There are a few noticeable difficulties: It looks like it's layered. DEST land and DEST 0? Also RANDOMIZE USING is something that I have never come across. Sounds like a challenge to me... Anyway, it's just gone 8am, and it too early for so much brain drain... Ooo... coffee might help...

J

Yes! Randomize Using, I forgot about that.

You'd think RND returns... well random numbers but in fact they aren't at all random, they are a repeatable sequences, all you need is different seeds and to start the unfolding from the beginning. Each firework flame was rebuilt from scratch from the seed assigned to the flame, it's color, it's path, it's speed along x and y directions, nothing was saved in arrays but the seed number ...each screen shot!

And each screen shot reads the points in the sky and reflects them in lake along the shore and each screen shot alters alittle or allot the pixels or color in the hugely magnified text.

Here is a much better board maker. It uses two levels of starting over in filling a box or 3x3 cellBlock. First attempting to add a number to the 9 cellBlocks and will try 20 times before starting over from scratch.

These Sudoku Boards are good because they don t repeat 3 sets of digits over and over (in different permutations) throughout the board.

' Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-09

'attempt a very different way to load a grid that might offer more variety than first successful attempt

randomize
dim grid(8, 8) 'global access

'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 "Press enter for another, any else quits ";more
if len(more) then end
wend

'this will either put the number in the grid's sellBlock or return 0 for failure
func 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 = 1
end

'the master sub for which loadCell function was designed
sub 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
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 = 0
end

sub
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 function
func 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 = 1
end



If
I am not mistaken, this method might be a little quicker than the one used by Chris because it s not checking to whole board at each round but only for the last number to finish the grid.

A modification of this method might be used for a random solver though I think I d prefer a more systematic approach that does t repeat taking bad paths.

Aha! I finally found a cell hiding algo that works towards my goal to create puzzles with unique solutions.

It is my conjecture that if you leave a cell in every row and column of a box (3 minimum), you will more likely create a puzzle with one unique solution, not guaranteed just more likely. I have noticed that such a homogeneous distribution is also pleasing to the eye and invites this person to play Sudoku more than a pure random scattering of hidden cells. Such an arrangement also leaves 3 cells in every row and column of the grid for the hardest level with 33% of cells showing clues. It doesnt look so hopelessly impossible.

BTW there are puzzles that show only 18 clues! that supposedly have unique solutions. That is 2 cells per box on average!


' Make #3 Board Test Hiding.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-14

'from make #2 Board Maker, now test hiding cells
'aha! I have defined levels well for myself at least!

randomize
dim grid(8, 8) 'global access to use between calls to functions using them

while 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 end
wend

sub
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
next
end

'this will either put the number in the grid's cellBlock or return 0 for failure
func 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 = 1
end

'the master sub for which loadCell function was designed
sub 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 = 0
end

sub
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 function
func 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 = 1
end



I hope to modify this code to target certain number clues for each box as it is also my conjecture that unique solutions will have at least each of the 9 numbers showing somewhere in the puzzle (It may be that they each have to show twice. I will bet the study and science of Sudoku Puzzles is out there somewhere already.)

Here is my latest version of Sudoku for SB (and QB64), it lets you know when you ve solved the puzzle and offers 3 trainer levels and 3 playing levels though I doubt level 6 is much use.


' Sudoku Game mod 3 nice hide.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-16
' finally a nice hide method??? eh... different!

'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

randomize
const TextSize = textwidth("9")
const CellSize = TextSize * 5
const xMinBoard = CellSize
const yMinBoard = CellSize
const xMaxBoard = xMinBoard + 9 * CellSize
const yMaxBoard = yMinBoard + 9 * CellSize
const xMidBoard = xMinBoard + (xMaxBoard - xMinBoard)/2
const yMidBoard = yMinBoard + (yMaxBoard - yMinBoard)/2
const xMinKeyPad = xMinBoard - .5 * CellSize
const xMaxKeyPad = xMinKeyPad + CellSize * 10
const yMinKeyPad = yMaxBoard + 10
const yMaxKeyPad = yMinKeyPad + CellSize

'main loop sets up game puzzle,
'when solved it flashes that fact and then sets up another puzzle
while 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 8 any else quits "; level
IF level < 0 OR level > 9 THEN 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
xit = 0
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) 'where's the mouse?
showGrid
DELAY 900
COLOR 15, 0
CLS
at xMidBoard - 7 * TextSize, yMidBoard - .5 * TextSize : ? "Puzzle solved!"
DELAY 300
WEND
END IF
wend

' add solved function
func 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 = 1
end

' displays the game grid, mainly as Chris with more constants
sub 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, 7
end

func
loadCell(n, cellBlock)
local xoff, yoff, xstop, ystop, list, x, y
local xx, yy, available, i, pointer, cell, r
local wait
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
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 = 1
end

sub
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
tCount++
if cnt >= 20 then startOver = 1 : tStartOver++ : exit for
grid = temp
exit for
fi
next
if startOver then exit loop
until success
if startOver then exit for
next
until startOver = 0
end

sub
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
wend
end



I hope to get a Solver working so I can check puzzle boards for unique solutions or not.

I also hope to return cell notes to the program to help with advanced level boards.

EDIT: tiny change to delay in main loop after inner wend, delay 300 NOT delay .1