Author 
Topic: Sudoku (Read 548 times) 

bplus
Senior Member
member is offline
Gender:
Posts: 1291


Sudoku
« Thread started on: Jan 7^{th}, 2018, 10:34am » 

Hi,
I am not finding anything in searches for Sudoku here at JB, LB or JB wiki.
I can't believe there is nothing on this classic game! Maybe I didn't search back far enough 1700 days?
I am studying it in other BASICs and want to check out alternate ways to set up a puzzle.


Logged

B+



Rod
Administrator
member is offline
Graphics = Goosebumps!
Gender:
Posts: 3187


Re: Sudoku
« Reply #1 on: Jan 7^{th}, 2018, 1:02pm » 

Uncle Ben posted on the Just basic files archive


Logged




bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #2 on: Jan 7^{th}, 2018, 3:48pm » 

Thanks Rod! So 6 years back at least...
In the mean time, I worked out some code that makes pretty good puzzles. I can toggle random puzzles until it shows me any digit in any grid position, no waiting. I will compare to Uncle Ben's JB code.


Logged

B+



rtr
Member in Training
member is offline
Posts: 43


Re: Sudoku
« Reply #4 on: Jan 8^{th}, 2018, 08:35am » 

on Jan 8^{th}, 2018, 05:41am, Cassiope34 wrote:or this thread 

There's a socalled 'diabolic' puzzle in that thread which takes a couple of minutes to solve according to the posts there. I just tried it with my Sudoku solver, and it found the solution in a fraction of a second. Just saying!
I've just noticed that it can be made harder: there's still a unique solution if you omit the '9' in the second row:
xxx67xxxx xxx4xxx28 x2xxxx3xx xxxxxx5x6 xx57x49xx 9x1xxxxxx xx2xxxx8x 85x9x6xx1 xxxx45xxx
With that change my program takes about a second.
Richard.

« Last Edit: Jan 8^{th}, 2018, 08:48am by rtr » 
Logged




bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #5 on: Jan 8^{th}, 2018, 09:52am » 

I am just trying to set up a game and I would like it to be possible to present any board possible for Sudoku.
I have idea for 3.65 x 10 ^ 12 boards but Wiki says many more are possible: Code:' Number of Sudoku grids according to Wiki
numberOfBoards = factorial(9) * (72 ^ 2) * (2 ^ 7) * 27704267971
myNumber = factorial(9) * 6 ^ 9
'test e10$
r = rnd(1)
print "Testing e10$ Function For Random Number: ";r
for p = 5 to 5
print " x 10 ^ ";p;" = ";e10$(r * (10 ^ p))
next
print
print "According to Wiki, Number of Sudoku boards possible is ";e10$(numberOfBoards)
print
print "My number of boards possible is ";e10$(myNumber)
print
print "So I am short about ";e10$(numberOfBoards  myNumber);" Yikes! :O"
print
print "hmm... the number of permutations on a 9x9 board is 9! ^ 9"
print "Which is ";e10$(factorial(9) ^ 9)
function factorial(n)
f = 1
while n > 1
f = f * n
n = n  1
wend
factorial = f
end function
function e10$(n)
if n >= 10 then
while n >= 10
cnt = cnt + 1
n = n /10
wend
e10$ = str$(n) + " x 10 ^ " + str$(cnt)
else
if n >= 1 then
e10$ = str$(n)
else
while n < 1
cnt = cnt + 1
n = n * 10
wend
e10$ = str$(n) + " x 10 ^ " + str$(cnt)
end if
end if
end function
So far I have looked at code from 3 sources for setting up boards. With Uncle Ben's SM2500, I can't even find where in the 1600+ lines he is setting up his puzzles. (I am trying SM2000 next as it is 1000 lines smaller!) In the other 2 sources they try stuff and there is a possibility to get stuck, so the code bails out and then calls itself for another try. I am not liking that method.
I think there should be a systematic way to create a board randomly without bailout, done in a very short amount of time.
Perhaps a solver working on a blank board? :D
BTW, Uncle Ben has produced a really fine Sudoku Game, Tutorial and Solver! (Well I can't speak for the Solver, but it seems the only Game in JB Town).
No one has attempted to improve on it in over 12 years! Really? As far as playing the game, it has some room for improvement, I think. ;)
For one, the key you are clicking into squares should be highlighted, including if you are using the ? for side notes (that aspect is very confusing).
For another the background colors for numbers squares interfere with seeing the 3x3 cells AND worse I was mislead by their meaning which meant allot of wasted time with screwed up games. (Sure playing games is a waste of time, but it's worse when playing a screwed up game!)
After figuring out how to present any board possible, the next study will be how to hide the cells without loosing the uniqueness of the solution for the puzzle. Maybe again, a good solver could help with that task?

« Last Edit: Jan 8^{th}, 2018, 10:26am by bplus » 
Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #6 on: Jan 10^{th}, 2018, 10:51am » 

Well this looks like perfect board maker code for Sudoku! ;)) Code:' MakeGrid for Sudoku Board.bas JB 2.0 b1 (B+=MGA) 20180110
' translate from: Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 20180107
' My first attempt to have a board without a restart.
' To have a board, first start with one, then scramble rows and column and cell blocks.
' Then to protect the innocent, change all (or not all) the names.
dim grid(8, 8) 'main purpose here is to load this with Sudoku Board
dim ta(9) 'temp array for swapping number names
'test grids have solutions for Sudoku Game
while 1
call makeGrid
call showGrid
if solved() then a$ = "Yes!" else a$ = "Oops, nope."
print : print " Grid solveable ? answer: ";a$
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 accidentally discovered increment 1 (above) 2, 4, 5, 7, 8 all work for same starter!
do 'choose from 6 setup boards
rIncrement = Int(rnd(1) * 8) + 1
loop until rIncrement <> 3 and rIncrement <> 6
for col = 0 to 8
select case starter
case 0 : starter = 1
case 7 : starter = 2
case 8 : starter = 3
case else : starter = starter + 3
end select
slider = starter
for row = 0 to 8
grid(col, row) = slider
slider = slider + rIncrement
if slider > 9 then slider = slider mod 9
next
next
'potentially shuffling 9 rows, 9 cols, 3 vertical cell blocks or 3 horizontals
for i = 0 to 23
swapMode = int(rnd(1) * 24)
cellSet = int(rnd(1) * 3) ' first, second, third
rc1 = int(rnd(1) * 3) ' 0, 1, 2
do
rc2 = int(rnd(1) * 3) ' to swap with rc1 0, 1, 2 Not = rc1
loop until rc2 <> rc1
for slider = 0 to 8 ' reusing a variable
select case
case swapMode < 9 ' swap rows
t = grid(slider, cellSet * 3 + rc1)
grid(slider, cellSet * 3 + rc1) = grid(slider, cellSet * 3 + rc2)
grid(slider, cellSet * 3 + rc2) = t
case swapMode < 18 ' swap columns
t = grid(cellSet * 3 + rc1, slider)
grid(cellSet * 3 + rc1, slider) = grid(cellSet * 3 + rc2, slider)
grid(cellSet * 3 + rc2, slider) = t
case swapMode < 21 ' swap cell block rows
for j = 0 to 2
t = grid(slider, rc1*3 + j)
grid(slider, rc1*3 + j) = grid(slider, rc2*3 + j)
grid(slider, rc2*3 + j) = t
next
case swapMode < 24 ' swap cell block columns
for j = 0 to 2
t = grid(rc1*3 + j, slider)
grid(rc1*3 + j, slider) = grid(rc2*3 + j, slider)
grid(rc2*3 + j, slider) = t
next
end select
next
next
'for 9! permutations of number substitutes or codes
'OK code the numbers st 1 is made another number 19, and then 2 and then 3...
dim ta(9)
for i = 1 to 9 : ta(i) = i : next
for i = 9 to 2 step 1 'shuffle
r = int(rnd(1) * i) + 1
t = ta(i)
ta(i) = ta(r)
ta(r) = t
next
for col = 0 to 8
for row = 0 to 8
grid(col, row) = ta(grid(col, row))
next
next
end sub
' add solved function, check a grid is playable (or solved)
function 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 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 = 1
end function
sub showGrid
cls
for r = 0 to 8
for c = 0 to 8
locate int(c/3) * 2 + (c + 2) * 3, int(r/3) + r + 2 : print grid(c, r)
next
next
end sub
My first file edited and spell checked with new version of NotePad ++, worked very well blocking indentations and changing case.
Now how do we hide cells without loosing uniqueness of solution?

« Last Edit: Jan 10^{th}, 2018, 10:51am by bplus » 
Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #7 on: Jan 10^{th}, 2018, 11:35pm » 

Oh I just discovered these grids have a fatal weakness that makes them too easy to solve!


Logged

B+



Rod
Administrator
member is offline
Graphics = Goosebumps!
Gender:
Posts: 3187


Re: Sudoku
« Reply #8 on: Jan 11^{th}, 2018, 03:31am » 

Yes it is pairing three number sets together every time.


Logged




bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #9 on: Jan 11^{th}, 2018, 2:33pm » 

I managed to find Uncle Ben's game Board setup code for Sudoku and have isolated it into the sub makeGrid. It is almost right but something is a little off.
Can anyone see the error? Code:'isolate uncle bens create code.bas 20180111 in the sub makeGrid from SM2000.bas
'all Uncle Ben's code is in the makeGrid subroutine, something is a little off
'add to some of that sets up on MainWin:
' MakeGrid for Sudoku Board.bas JB 2.0 b1 (B+=MGA) 20180110
' translate from: Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 20180107
dim grid(8, 8) 'main purpose here is to load this with Sudoku Board
'test grids have solutions for Sudoku Game
while 1
scan
call makeGrid
call showGrid
if solved() then a$ = "Yes!" else a$ = "Oops, nope."
print : print " Grid solveable ? answer: ";a$
input " Press enter for another, any else quits ";more$
if len(more$) then end
scan
wend
sub makeGrid 'attempt to isolate Uncle Ben's Board Making Code
r$ = "123456789" 'declared in main ini
' n$ is being used to tick off found items and is reset to r$ at every new x
'=================== GUI stuff
'[create] =================================== 'start board setup
' print #main.new, "!disable"
' print #main.solve, "!disable"
' print #main.check, "!disable"
' print #main.graph, "cls"
' gosub [drawGrid]
' 'reset a$(0,0)...a$(8,8)
'=================== arrays setup in main initial code
'a$(x, y) = grid(x, y)
'b$(x, y) = some copy?
'fixa(x, y) = another copy but with numbers not strings!
'fixb(x, y) = still another copy with numbers
'clearing arrays
for y = 0 to 8
for x = 0 to 8
'a$(x, y) = ""
grid(x,y) = 0
'b$(x, y) = ""
'fixa(x, y) = 0
next x
next y
'set up a$(0,0)...a$(8,8)
'=================== GUI stuff
'print #main.controls, "cls; backcolor "; green$; "; color "; green$
'print #main.controls, "place 1 1; boxfilled 201 81; color black"
y = 0
'prog = 0
do
'=================== GUI stuff
'prog1 = y*12.5
'if prog < prog1 then
'prog = prog1
'print #main.controls, "place 20 45"
'print #main.controls, "\Creating "; prog; "%..."
'end if
scan
x = 0
for x = 0 to 8
n$ = r$
d = y/3  int(y/3)
if d > 0 then gosub [checkSquare]
if x >= 0 then gosub [checkRow]
if y >= 0 then gosub [checkColumn]
if n$ = "" then
counter = counter + 1
goBack = 1
if counter > 10 then goBack = 2
exit for
end if
z = int(rnd(1)*len(n$)) + 1
'a$(x, y) = mid$(n$, z, 1)
grid(x, y) = val(mid$(n$, z, 1))
next x
y = y + 1
if goBack = 1 then
goBack = 0
y = y1
end if
if goBack = 2 then
goBack = 0
counter = 0
y = y2
end if
loop until y = 9
exit sub '================================== end of gosub
'======== Uncle Ben just using random hiding! according to difficulty$
'print numbers on the screen
'for y = 0 to 8
' for x = 0 to 8
' z = rnd(1)
' select case difficulty$
' case "easy"
' if z < 0.5 then fixa(x, y ) = 1 : gosub [selectReveal]
' case "normal"
' if z < 0.4 then fixa(x, y ) = 1 : gosub [selectReveal]
' case "hard"
' if z < 0.3 then fixa(x, y ) = 1 : gosub [selectReveal]
' end select
' next x
'next y
'=================== GUI stuff
'print #main.graph, "flush"
'print #main.new, "!enable"
'print #main.solve, "!enable"
'print #main.check, "!enable"
'print #main.controls, "cls"
'gosub [drawControls]
'print #main.controls, "place 1 1; backcolor "; green$
'print #main.controls, "boxfilled 39 39"
'selection = 0
'print #main.graph, "when leftButtonUp [writeNumber]"
'print #main.controls, "when leftButtonUp [selectNumber]"
'wait
'========================= gosubs used for gosub create
[checkSquare]
index = int(x/3)*3
a = index
b = int(y/3)*3
do
'z = instr(n$, a$(a, b))
z = instr(n$, str$(grid(a, b)))
if z > 0 then n$ = left$(n$, z1) + right$(n$, len(n$)z)
a = a + 1
if a  index > 2 then
a = index
b = b + 1
end if
loop until a = x and b = y
return
[checkRow]
index = 0
for index = 0 to x1
'z = instr(n$, a$(index, y))
z = instr(n$, str$(grid(a, b)))
if z > 0 then n$ = left$(n$, z1) + right$(n$, len(n$)z)
next index
return
[checkColumn]
index = 0
for index = 0 to y1
'z = instr(n$, a$(x, index))
z = instr(n$, str$(grid(a, b)))
if z > 0 then n$ = left$(n$, z1) + right$(n$, len(n$)z)
next index
return
end sub
' add solved function, check a grid is playable (or solved)
function 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 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 = 1
end function
sub showGrid
cls
for r = 0 to 8
for c = 0 to 8
locate int(c/3) * 2 + (c + 2) * 3, int(r/3) + r + 2 : print grid(c, r)
next
next
end sub
EDIT: removed code I started working on to hideCells as it wasn't nearly finished and might confuse the issue of getting Uncle Ben's code working for making a Sudoku puzzle grid of numbers.

« Last Edit: Jan 11^{th}, 2018, 10:25pm by bplus » 
Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #10 on: Jan 11^{th}, 2018, 11:58pm » 

Well, I have proper Sudoku Board Maker worked out on my own now.
Code:' Make Grid 2.bas JB 2.0 b1 (B+=MGA) 20180111
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 20180109
'ah, a proper Sudoku Game Board!
'Globals
global tCount, tStartOver
dim grid(8, 8) 'main purpose here is to load this with Sudoku Board
'dim list(8) 'is used in the loadCell Function
'dim cell(available) 'temp array for storing cells available to fill
'test grids have solutions for Sudoku Game
while 1
tCount = 0 : tStartOver = 0
call makeGrid
call showGrid
if solved() then a$ = "Yes!" else a$ = "Oops, nope."
print : print " Grid solveable ? answer: ";a$
print " Total cellBlock redo's ";tCount
print " 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 cellBlock or return 0 for failure
function loadCell(n, cellBlock)
'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 numbers 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 'it's 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
next
if bad = 0 then
for xx = 0 to xstop
if grid(xx, yoff + y) = n then bad = 1 : exit for
next
end if
if bad = 0 then available = available + 1 : list(3 * y + x) = 1
end if
next
next
'if nothing is available then bug out
if available = 0 then loadCell = 0 : exit function
redim 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
loadCell = 1
end function
'the master sub for which loadCell function was designed
sub makeGrid
'this version requires the assistance of loadCell sub routine
do
dim grid(8, 8) : startOver = 0
for n = 1 to 9
'temp = grid
for r = 0 to 8
for c = 0 to 8
temp(c, r) = grid(c, r)
next
next
cnt = 0
do
for i = 1 to 9
cellBlock = val(mid$("013246578", i , 1))
success = loadCell(n, cellBlock)
if success = 0 then
cnt = cnt + 1
tCount = tCount + 1
if cnt >= 20 then startOver = 1 : tStartOver = tStartOver + 1 : exit for
'grid = temp
for r = 0 to 8
for c = 0 to 8
grid(c, r) = temp(c, r)
next
next
exit for
end if
next
if startOver then exit do
loop until success
if startOver then exit for
next
loop until startOver = 0
end sub
' add solved function, check a grid is playable (or solved)
function 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 = 1
end function
sub showGrid
cls
for r = 0 to 8
for c = 0 to 8
locate int(c/3) * 2 + (c + 2) * 3, int(r/3) + r + 2 : print grid(c, r)
next
next
end sub


Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #11 on: Jan 12^{th}, 2018, 03:21am » 

And so here is a main window version of Sudoku.
The cells were not hidden randomly but systematically!
Code:' Sudoku Game in mainwin.bas JB 2.0 b1 (B+=MGA) 20180111
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 20180109
'now for a mainwin Game of Sudoku!
'designed for Preference setting of:
' Main window 80 columns and 25 rows
'Globals
global Limit
dim grid(8, 8) 'main purpose here is to load this with Sudoku Board
'dim list(8) 'is used in the loadCell Function
'dim cell(available) 'temp array for storing cells available to fill
locate 1, 6
print " Welcome to bplus Sudoku!":print
print " To begin, please enter a level of difficulty."
input " Enter 1 for very easy up to 10 for very hard! any else quits ";level
if level < 1 or level > 10 then end
Limit = level/10 * 56
'test grids have solutions for Sudoku Game
while 1
call makeGrid
call hideCells
call showGrid
while solved() = 0
call showGrid
locate 22, 21
input "Enter Col Row Number (no spaces) or q ";in$
if in$ = "q" then end
c = val(left$(in$, 1)) : r = val(mid$(in$, 2, 1)) : n = val(right$(in$, 1))
if c >= 1 and c <= 9 and r >= 1 and r <= 9 and n >= 1 and n <= 9 then
if grid(c1, r1) <= 0 then grid(c1, r1) = 1 * n else beep
end if
wend
call showGrid
locate 32, 20: print "Yeah! Puzzle Solved!"
locate 22, 22: input "Press enter for another, any else quits ";more$
if len(more$) then cls: end
wend
'this will either put the number in the grid's cellBlock or return 0 for failure
function loadCell(n, cellBlock)
'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 numbers 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 'it's 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
next
if bad = 0 then
for xx = 0 to xstop
if grid(xx, yoff + y) = n then bad = 1 : exit for
next
end if
if bad = 0 then available = available + 1 : list(3 * y + x) = 1
end if
next
next
'if nothing is available then bug out
if available = 0 then loadCell = 0 : exit function
redim 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
loadCell = 1
end function
'the master sub for which loadCell function was designed
sub makeGrid
'this version requires the assistance of loadCell sub routine
do
dim grid(8, 8) : startOver = 0
for n = 1 to 9
'temp = grid
for r = 0 to 8
for c = 0 to 8
temp(c, r) = grid(c, r)
next
next
cnt = 0
do
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
for r = 0 to 8
for c = 0 to 8
grid(c, r) = temp(c, r)
next
next
exit for
end if
next
if startOver then exit do
loop until success
if startOver then exit for
next
loop until startOver = 0
end sub
' add solved function, check a grid is playable (or solved)
function 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 = 1
end function
sub showGrid
cls
locate 17, 4: print time$();space$(10);"SU DOKU"; space$(10);date$("yyyy/mm/dd")
locate 14, 6: print "Col > 1 2 3 4 5 6 7 8 9"
locate 14, 7: print "Row v"
for r = 0 to 8
locate 18, int(r/3) + r + 8 : print r + 1;">"
for c = 0 to 8
if grid(c, r) = 0 then p$ = " ? "
if grid(c, r) > 0 then p$ = " ";grid(c, r);"."
if grid(c, r) < 0 then p$ = " ";abs(grid(c, r));" "
locate int(c/3) * 2 + (c + 2) * 4 + 15, int(r/3) + r + 8 : print p$
next
next
end sub
sub hideCells
'a more systematic hiding of cells?
Block = int(rnd(0)*9) : Number = int(rnd(0)*9) + 1 : Hidden = 0
do
scan
found = 0
cellCol = (Block mod 3) * 3
cellRow = int(Block/3) * 3
for r = 0 to 2
for c = 0 to 2
scan
if grid(cellCol + c, cellRow + r) = Number then
grid(cellCol + c, cellRow + r) = 0
Hidden = Hidden + 1
if Hidden mod 9 = 0 then Number = Number + 1
Number = Number + 1
if Number > 9 then Number = 1
found = 1 : exit for
end if
next
if found then exit for
next
Block = Block + 1
if Block > 8 then Block = 0
loop until Hidden >= Limit
end sub

« Last Edit: Jan 12^{th}, 2018, 03:22am by bplus » 
Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #12 on: Jan 12^{th}, 2018, 1:44pm » 

Oh dang! The hiding of cells is too obvious.
Fortunately I have a fix, coming soon! (just commenting code better)
Stay tuned...


Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #13 on: Jan 12^{th}, 2018, 4:53pm » 

Fixed and more touch ups! Code:' Sudoku Game 2 in mainwin.bas JB 2.0 b1 (B+=MGA) 20180112
' 20170112 game 2 for mainwin fixes problem with too predictable a hiding of cells
' by adding a getNumber function to randomly shuffle a sequence of numbers and draw
' them like cards from a deck. This allows an even reduction of numbers in
' rows, columns and cellBlocks.
' 20170111 Sudoku Game in mainwin with modified makeGrid, test new hideCells sub
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 20180109
'designed for Preference setting:
' Main window 80 columns and 25 rows
'Globals
global cellLimit, deckPointer 'cellLimit tracks number of cells to hide
dim grid(8, 8) 'main purpose here is to load this with Sudoku Board
dim deck(8) 'for cell hiding, this works with dp between calls to drawNumber function
'dim list(8) 'is used in the loadCell Function
'dim cell(available) 'temp array for storing cells available to fill
'setup deck for drawing numbers randomly 1 through 9 and then reshuffle for more
for i = 0 to 8 : deck(i) = i : next
deckPointer = 0
'welcome and get difficulty level
locate 22, 5 : print "Welcome to Sudoku Game in JB Mainwin!"
locate 18, 9 : print "To begin, please enter a level of difficulty."
locate 10, 11 : input "Enter 1 for very easy up to 10 for very hard! any else quits ";level
if level < 1 or level > 10 then cls : end
cellLimit = int(level/10 * 56)
'test getNumber() should cycle through set on numbers 1 to 9 randomly ordered and repeat
'for i = 1 to 50 : print getNumber(); : next : print
'input "Press enter ";ok$
' Game on!
while 1
call makeGrid
call hideCells
call showGrid
while solved() = 0 'show puzzle update and get player's next move
call showGrid
locate 22, 21
input "Enter Col Row Number (no spaces) or q ";in$
if in$ = "q" then cls : end
'make sure move is OK, if not beep
c = val(left$(in$, 1)) : r = val(mid$(in$, 2, 1)) : n = val(right$(in$, 1))
if c >= 1 and c <= 9 and r >= 1 and r <= 9 and n >= 1 and n <= 9 then
if grid(c  1, r  1) <= 0 then grid(c  1, r  1) = 1 * n else playwave "error.wav", async
else
playwave "error.wav", async
end if
wend
'display the solved puzzle, rave and allow to play again
call showGrid
locate 32, 20: print "Yeah! Puzzle Solved!"
locate 22, 22: input "Press enter for another, any else quits ";more$
if len(more$) then cls: end
wend
'this will either put the number in the grid's cellBlock or return 0 for failure
function loadCell(n, cellBlock)
'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 numbers before (n, cellBlock) are done
'make a list of free cells in cellBlock
dim list(8)
'search cellBlock for opening, check that rows and cols before cellBlock are clear of number
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 'it's 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
next
if bad = 0 then 'don't bother checking cols
for xx = 0 to xstop 'check cols
if grid(xx, yoff + y) = n then bad = 1 : exit for
next
end if
if bad = 0 then available = available + 1 : list(3 * y + x) = 1
end if
next
next
'if nothing is available then indicate the function was unsuccessful and bug out
if available = 0 then loadCell = 0 : exit function
redim cell(available)
pointer = 1
for i = 0 to 8 'load cell() with just the available cell prospects
if list(i) then cell(pointer) = i : pointer = pointer + 1
next
'OK to pick one randomly, shuffle cells
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 into the grid
grid(xoff + (cell(1) mod 3), yoff + int(cell(1) / 3)) = n
'indicate the function successfully loaded a cell
loadCell = 1
end function
'the master sub for which loadCell function was designed
sub makeGrid
'this version requires the assistance of loadCell sub routine
do
dim grid(8, 8) : startOver = 0
for n = 1 to 9
'temp = grid store the grid in temp array in case things go bad we can recover
for r = 0 to 8
for c = 0 to 8
temp(c, r) = grid(c, r)
next
next
cnt = 0
do ' fill n in all cell blocks, retry up to 20 times if fail
for cellBlock = 0 to 8
success = loadCell(n, cellBlock)
if success = 0 then 'no load of number to cell block, try again?
cnt = cnt + 1 'count attempts
if cnt >= 20 then startOver = 1 : exit for 'give up on this grid formation
'grid = temp recover the grid
for r = 0 to 8
for c = 0 to 8
grid(c, r) = temp(c, r)
next
next
exit for
end if
next
if startOver then exit do
loop until success
if startOver then exit for
next
loop until startOver = 0
end sub
' check a grid is playable (or solved)
function 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 = 1
end function
sub showGrid 'update screen with current state of affairs (including time and date!)
cls
locate 18, 4: print time$();space$(10);"SUDOKU"; space$(10);date$("yyyy/mm/dd")
locate 14, 6: print "Col > 1 2 3 4 5 6 7 8 9"
locate 14, 7: print "Row v"
for r = 0 to 8
locate 18, int(r/3) + r + 8 : print r + 1;">"
for c = 0 to 8
if grid(c, r) = 0 then p$ = "  "
if grid(c, r) > 0 then p$ = " ";grid(c, r);"."
if grid(c, r) < 0 then p$ = " ";abs(grid(c, r));" "
locate int(c/3) * 2 + (c + 2) * 4 + 15, int(r/3) + r + 8 : print p$
next
next
end sub
'cycle randomly through numbers 1 through 9 and then again...
function getNumber()
'deckPointer is global, as is deck(), and points to next in deck to get number.
'Reshuffle deck when pointer starts or cycles back to beginning of deck.
if deckPointer = 0 then 'shuffle
for i = 8 to 1 step 1
r = int(rnd(0) * i)
t = deck(i)
deck(i) = deck(r)
deck(r) = t
next
end if
getNumber = deck(deckPointer) + 1 'to get numbers 1 to 9, add 1
deckPointer = deckPointer + 1
if deckPointer > 8 then deckPointer = 0
end function
' Once grid is setup hide cells (may loose unique solution of original grid)
' according to the level of difficulty decided at the beginning of session.
sub hideCells
'a more systematic hiding of cells?
Block = 1 : Number = getNumber() : Hidden = 0
do
scan
found = 0
cellCol = (Block mod 3) * 3
cellRow = int(Block/3) * 3
for r = 0 to 2
for c = 0 to 2
scan
if grid(cellCol + c, cellRow + r) = Number then
grid(cellCol + c, cellRow + r) = 0
Hidden = Hidden + 1
Number = getNumber()
found = 1 : exit for
end if
next
if found then exit for
next
Block = Block + 1
if Block > 8 then Block = 0
loop until Hidden >= cellLimit
end sub


Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1291


Re: Sudoku
« Reply #14 on: Jan 14^{th}, 2018, 10:23am » 

Game design decision:
Levels: (a "box" is one of 9 3x3 cells in the grid, in each of which a whole set of numbers 1 to 9 must fit). I have designated levels to how many cells to remove from each box. So level 1 is 1 cell from each box and this level is good for "flash card" training, to see and type or click the missing number faster than the mind can think. The same goes for level 2 and 3, trainers for automatic processing without brain slowing you down. Levels 4, 5, 6 are the more familiar equivalent to easy, intermediate and hard: leaving 56% (really easy!), 44% (easyintermediate) and 33% (easyhard level) number cells in boxes and grid both.
I am pleased to announce I finally found a formula or recipe for hiding cells that guarantees a cell in every row and column of a box thus guarantees 3 cells in every row and column of the whole grid on the hardest level that is still random. The hardest level removes 6 of 9 cells in every box leaving 33% of cells.
My conjecture is that such a homogeneous distribution of hidden cells will be least likely to generate multiple solutions deviating from the original puzzle devised from the start. This conjecture will be explored when I start playing around with Solvers.
I think I can further target numbered cells for a homogeneous distribution of them when hiding cells. Again this is an effort to reduce the likelihood of multiple solutions from the original puzzle devised.
My goal is to make puzzles where only one number works for each cell that leads to solution that is the same as original puzzle setup.
If any of you can remember way back when you played around with Sudoku Games and have experience in setting up puzzle boards with unique solutions, I hope you share it.


Logged

B+



