Board Logo
« Sudoku »

Welcome Guest. Please Login or Register.
Jan 21st, 2018, 02:57am


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Sudoku  (Read 235 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Sudoku
« Thread started on: Jan 7th, 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.
User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Sudoku
« Reply #1 on: Jan 7th, 2018, 1:02pm »

Uncle Ben posted on the Just basic files archive
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #2 on: Jan 7th, 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.
User IP Logged

B+
Cassiope34
New Member
Image


member is offline

Avatar




PM

Gender: Male
Posts: 1
xx Re: Sudoku
« Reply #3 on: Jan 8th, 2018, 05:41am »

or this thread wink http://justbasic.conforums.com/index.cgi?board=games&num=1321726830&action=display&start=0

Cheers

Gilles
User IP Logged

rtr
Member in Training
ImageImage


member is offline

Avatar




PM


Posts: 42
xx Re: Sudoku
« Reply #4 on: Jan 8th, 2018, 08:35am »

on Jan 8th, 2018, 05:41am, Cassiope34 wrote:
or this thread wink

There's a so-called '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! tongue

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 8th, 2018, 08:48am by rtr » User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #5 on: Jan 8th, 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 8th, 2018, 10:26am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #6 on: Jan 10th, 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) 2018-01-10
' translate from: Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-07
' 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 solve-able ? 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 1-9, 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 10th, 2018, 10:51am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #7 on: Jan 10th, 2018, 11:35pm »

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

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Sudoku
« Reply #8 on: Jan 11th, 2018, 03:31am »

Yes it is pairing three number sets together every time.
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #9 on: Jan 11th, 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 2018-01-11 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) 2018-01-10
' translate from: Make Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-07


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 solve-able ? 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 = y-1
        end if

        if goBack = 2 then
            goBack = 0
            counter = 0
            y = y-2
        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$, z-1) + 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 x-1
        'z = instr(n$, a$(index, y))
        z = instr(n$, str$(grid(a, b)))
        if z > 0 then n$ = left$(n$, z-1) + right$(n$, len(n$)-z)
    next index
    return

[checkColumn]
    index = 0
    for index = 0 to y-1
        'z = instr(n$, a$(x, index))
        z = instr(n$, str$(grid(a, b)))
        if z > 0 then n$ = left$(n$, z-1) + 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 11th, 2018, 10:25pm by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #10 on: Jan 11th, 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) 2018-01-11
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-09

'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 solve-able ? 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


 
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #11 on: Jan 12th, 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) 2018-01-11
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-09

'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(c-1, r-1) <= 0 then grid(c-1, r-1) = -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 12th, 2018, 03:22am by bplus » User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #12 on: Jan 12th, 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...
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #13 on: Jan 12th, 2018, 4:53pm »

Fixed and more touch ups!
Code:
' Sudoku Game 2 in mainwin.bas JB 2.0 b1 (B+=MGA) 2018-01-12
' 2017-01-12 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.
' 2017-01-11 Sudoku Game in mainwin with modified makeGrid, test new hideCells sub
' translate from: Make #2 Sudoku Board.bas SmallBASIC 0.12.11 (B+=MGA) 2018-01-09

'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

 
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Sudoku
« Reply #14 on: Jan 14th, 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% (easy-intermediate) and 33% (easy-hard 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.
User IP Logged

B+
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls