Basicprogramming(.org) > General questions and discussions

Sudoku

(1/3) > >>

B+:
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:
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.

B+:
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+:
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: ---' 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!

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
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

'check rows and columns before this cell block
for yy = 0 to ystop 'rows
if grid(xoff + x,  yy) = n  then
exit for
fi
next
for xx = 0 to xstop
if grid(xx, yoff + y) = n then
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
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
grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
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
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

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

--- End code ---

4 days to get a dozen lines of code, sheeze!

B+:
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: ---' 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

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 yMinKeyPad = yMaxBoard + 10

'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 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
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

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
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
? x
i += CellSize
next
end

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
'check rows and columns before this cell block
for yy = 0 to ystop 'rows
if grid(xoff + x,  yy) = n  then
exit for
fi
next
for xx = 0 to xstop
if grid(xx, yoff + y) = n then
exit for
fi
next
fi
if bad = 0 then available++ : list(3*y + x) = 1
end if
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
grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
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))
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 = 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

--- End code ---