## problem code regarding sudoku solver

General Computer Utilities
TyCamden
Posts: 42
Joined: Tue Apr 28, 2009 6:20 am

### problem code regarding sudoku solver

problem code regarding sudoku solver

Code: Select all

``````  ' Simple GUI for SUDOKU, written by cassiope01  ( 11/18/2011 )
' Test recursivity to solve SUDOKU...
' Portage to JB from code in language C found here http://top-sudoku.com/sudoku/fr/exemple-backtracking-c.php

nomainwin

global sc, offset, cx, cy, bckcolor\$, selection, comp.tests, date\$
mois\$ = "Jan Fév Mar Avr Mai Jun Jui Aou Sep Oct Nov Déc"
today\$ = date\$("mm/dd/yyyy")
j = date\$(today\$)
jsem\$ = word\$("Mar Mer Jeu x Ven Sam x Dim Lun",int((j/7-int(j/7))*10)+1)
date\$ = jsem\$+" "+mid\$(today\$,4,2)+" "+word\$(mois\$, val(today\$))+"   "+left\$(time\$(),5)'right\$(today\$,4)

dim cell(9,9), temp(9,9), orderinfo(81,3)
sc = 60       'size of a cell, you can try to change...!
offset = 60   'distance from the edge
bckcolor\$ = "cyan"  'background color
solvedyet = 0

WindowWidth = 9 * sc + 2 * offset + offset/2
WindowHeight = WindowWidth + 20 '+ offset + offset/4
UpperLeftX = (DisplayWidth-WindowWidth) / 3
UpperLeftY = (DisplayHeight-WindowHeight) / 2

button #g.solveButton, "Solve", Solve, UL, 60, 620, 70, 30
button #g.newButton, "New", New, UL, 290, 620, 70, 30
button #g.hint, "Hint", Hint, UL, 170, 620, 70, 30
button #g.quitButton, "Quit", quit, UL, 520, 620, 70, 30
buttonsize = int(9*sc/10)
button #g.butt0, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+0*buttonsize, buttonsize, buttonsize
button #g.butt1, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+1*buttonsize, buttonsize, buttonsize
button #g.butt2, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+2*buttonsize, buttonsize, buttonsize
button #g.butt3, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+3*buttonsize, buttonsize, buttonsize
button #g.butt4, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+4*buttonsize, buttonsize, buttonsize
button #g.butt5, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+5*buttonsize, buttonsize, buttonsize
button #g.butt6, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+6*buttonsize, buttonsize, buttonsize
button #g.butt7, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+7*buttonsize, buttonsize, buttonsize
button #g.butt8, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+8*buttonsize, buttonsize, buttonsize
button #g.butt9, "", NumChoice, UL, WindowWidth-buttonsize-15, offset+9*buttonsize, buttonsize, buttonsize
open "    S U D O K U ..."+space\$(20)+date\$ for graphics_nf_nsb as #g  'window_nf
#g "trapclose quit"
#g "down"

for bt = 0 to 9
Bw\$ = "#g.butt";bt
#Bw\$ "!font Comic_Sans_MS ";sc/3
#Bw\$ bt
next

call makeSprite
call drawcube

#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
#g "font courrier_new ";sc/2

#g "setfocus"
#g "when characterInput player"
#g "when leftButtonDown Clic"
#g "when rightButtonDown Give"

WAIT

sub Hint handle\$
if grid.finished() then exit sub

#g "spritexy square -100 0"
#g "drawsprites"
#g "font courrier_new 10"
#g "place 60 ";WindowHeight-40;";|Searching a hint...."+space\$(20)
#g "font courrier_new ";sc/2

if solvedyet = 0 then
call resolve
solvedyet = 1
end if

orderinfo(lockspot,1) = cellx
orderinfo(lockspot,2) = celly
orderinfo(lockspot,3) = cell(cellx,celly)
lockspot = lockspot + 1

'show the cell chosen in a different color...
#g "color blue"
#g "place ";offset+(cellx-1)*sc+sc/5+sc/8;" ";offset+(celly-1)*sc+sc/2+sc/4;";|";cell(cellx,celly)
#g "place 60 ";WindowHeight-40;";|";space\$(120)
#g "color black"
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"

end sub

' below is the HINT sub as it was ORIGINALLY

#g "spritexy square -100 0"
#g "drawsprites"
#g "font courrier_new 10"
#g "place 60 ";WindowHeight-40;";|Searching a hint...."+space\$(20)
#g "font courrier_new ";sc/2

'save cell() into temp()
for ty = 1 to 9
for tx = 1 to 9
temp(tx,ty) = cell(tx,ty)
if cell(tx,ty) = 0 then empty.cell\$ = empty.cell\$+str\$(tx*10+ty)+" " :empty = empty + 1
next
next

'chose a random empty cell
cellx = val(left\$(word\$(empty.cell\$,int(rnd(0)*empty)+1),1))
celly = val(right\$(word\$(empty.cell\$,int(rnd(0)*empty)+1),1))

call resolve

temp(cellx,celly) = cell(cellx,celly)
'show the cell chosen in a different color...
#g "color blue"
#g "place ";offset+(cellx-1)*sc+sc/5+sc/8;" ";offset+(celly-1)*sc+sc/2+sc/4;";|";cell(cellx,celly)
#g "place 60 ";WindowHeight-40;";|";space\$(120)
#g "color black"
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"

'restore cell() with temp()
for ty = 1 to 9 :for tx = 1 to 9 :cell(tx,ty) = temp(tx,ty) :next :next
'    end sub

if fileName\$<>"" then
#g "spritexy square -100 0"
#g "drawsprites"
redim cell(9,9)
call drawcube
selection = 0
open fileName\$ for input as #grid
for gy = 1 to 9
LINE INPUT #grid, line\$
for gx = 1 to 9
c\$ = mid\$(line\$,gx,1)
if instr("123456789",c\$) then cell(gx,gy) = val(c\$)
next
next
close #grid
call affgrille
end if
end sub

sub Save
if grid.finished() then exit sub
open "Grid_"+left\$(date\$,11)+"_"+left\$(time\$(),2)+mid\$(time\$(),4,2)+right\$(time\$(),2)+".gri" for output as #save
for gy = 1 to 9
line\$ = ""
for gx = 1 to 9
line\$ = line\$ + str\$(cell(gx,gy))
next
#save, line\$
next
close #save
end sub

sub New handle\$
#g "spritexy square -100 0"
#g "drawsprites"
redim cell(9,9)
redim orderinfo(81,3)
call drawcube
selection = 0
solvedyet = 0
end sub

sub Solve handle\$
if solvedyet = 0 then
call resolve
solvedyet = 1
end if
#g "spritexy square -100 0"
#g "drawsprites"
#g "backcolor ";bckcolor\$;"; color black"
#g "font courrier_new 10"
#g "place 60 ";WindowHeight-40;";|Thinking...."+space\$(30)
#g "font courrier_new ";sc/2
deb = time\$("ms")
comp.tests = 0
call affgrille
scan
res = time\$("ms")-deb
sec = int(res/1000)
if sec > 0 then
if sec > 60 then
minute = int(sec/60)
sec = sec-minute*60
if minute then
res\$ = str\$(minute)+"  min  "+str\$(sec)+"  sec  "+str\$(res-(minute*60+sec)*1000)+"  ms."
end if
else
res\$ = str\$(sec)+"  sec  "+str\$(res-sec*1000)+"  ms.         "
end if
else
res\$ = str\$(res)+"  ms.                       "
end if
#g "font courrier_new 10"
#g "place 60 ";WindowHeight-40;";|";res\$
#g "font courrier_new ";sc/2
selection = 0
end sub

sub player handle\$, inkey\$       'keyboard input    ( 0 to erase this cell)
#g "spritexy square -100 0"
#g "drawsprites"
select case
case instr("0123456789",upper\$(left\$(inkey\$,1)))>0 and selection = 1
cell(cx,cy) = val(upper\$(left\$(inkey\$,1)))
#g "backcolor ";bckcolor\$
if cell(cx,cy) > 0 then
#g "place ";offset+(cx-1)*sc+sc/5+sc/8;" ";offset+(cy-1)*sc+sc/2+sc/4;";|";cell(cx,cy)
else
#g "color ";bckcolor\$
#g "place ";offset+(cx-1)*sc+4;" ";offset+(cy-1)*sc+4;";boxfilled ";offset+(cx-1)*sc+sc-4;" ";offset+(cy-1)*sc+sc-4 'erase
#g "color black"
end if
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
case upper\$(left\$(inkey\$,1)) = "S"   'solve this sudoku
call Solve "#g"
case upper\$(left\$(inkey\$,1)) = "N"   ' reinit
call New "#g"
end select
selection = 0
end sub

sub NumChoice handle\$
if selection then
#g "spritexy square -100 0"
#g "drawsprites"
cell(cx,cy) = val(right\$(handle\$,1))
#g "backcolor ";bckcolor\$
if cell(cx,cy) > 0 then
#g "place ";offset+(cx-1)*sc+sc/5+sc/8;" ";offset+(cy-1)*sc+sc/2+sc/4;";|";cell(cx,cy)
else
#g "color ";bckcolor\$
#g "place ";offset+(cx-1)*sc+4;" ";offset+(cy-1)*sc+4;";boxfilled ";offset+(cx-1)*sc+sc-4;" ";offset+(cy-1)*sc+sc-4 'erase
#g "color black"
end if
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
#g "spritexy square ";offset+(cx-1)*sc-2;" ";offset+(cy-1)*sc-2
#g "drawsprites"
end if
end sub

sub Give handle\$, mousex, mousey   'to give a good number
#g "spritexy square -100 0"
#g "drawsprites"
cx = int((mousex-offset)/sc)+1
cy = int((mousey-offset)/sc)+1
if cx > 9 then cx = 9
if cy > 9 then cy = 9
if cell(cx,cy) = 0 then
cell(cx,cy) = control(cx,cy)   'a good number with rnd() 1 - 9
if cell(cx,cy) > 0 then
#g "backcolor ";bckcolor\$
#g "place ";offset+(cx-1)*sc+sc/5+sc/8;" ";offset+(cy-1)*sc+sc/2+sc/4;";|";cell(cx,cy)
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
end if
end if
selection = 0
end sub

sub Clic handle\$, mousex, mousey   'to place the sprite to show the selection
cx = int((mousex-offset)/sc)+1
cy = int((mousey-offset)/sc)+1
if cx > 9 then cx = 9
if cy > 9 then cy = 9
#g "spritexy square -100 0"
#g "drawsprites"
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
#g "spritexy square ";offset+(cx-1)*sc-2;" ";offset+(cy-1)*sc-2
#g "drawsprites"
selection = 1
end sub

Function control(x,y)  'to never give a wrong number...
DO
control = int(rnd(0)*9)+1
cpt=cpt+1  'to avoid crash...
LOOP UNTIL ok(control,x,y)>0 or cpt > 50
if cpt > 50 then control = 0  'bug...!
end function

sub resolve

orderspot = 1
for xx = 1 to 9
for yy = 1 to 9
if cell(xx,yy) <> 0 then
orderinfo(orderspot,1) = xx
orderinfo(orderspot,2) = yy
orderinfo(orderspot,3) = cell(xx,yy)
orderspot = orderspot + 1
end if
next yy
next xx
lockspot = orderspot - 1

for yy = 1 to 9
for xx = 1 to 9
if cell(xx,yy) = 0 then
for nb = 1 to 9
'-----------------------possible ?-------------- direct coded to improve compute speed...
string\$ = "" :ok = 1
for c = 1 to 9
string\$ = string\$+" "+str\$(c)+str\$(yy)+" "
next
for c = 1 to 9
string\$ = string\$+" "+str\$(xx)+str\$(c)+" "
next
dx = 1*(xx<4)+4*(xx>3 and xx<7)+7*(xx>6)  'corner up/left of one of the nine big square
dy = 1*(yy<4)+4*(yy>3 and yy<7)+7*(yy>6)
for iy = 0 to 2
for ix = 0 to 2
string\$ = string\$+" "+str\$(dx+ix)+str\$(dy+iy)+" "
next
next
DO
for cp = 1 to 27
cpx = val(left\$(word\$(string\$,cp),1))
cpy = val(right\$(word\$(string\$,cp),1))
if cell(cpx,cpy) = nb then ok = 0 :exit for
next
LOOP UNTIL cp = 28 or ok = 0
'----------------------------------------------------
'if ok(nb,xx,yy) then
if ok then
nbre.tamp = cell(xx,yy)
cell(xx,yy) = nb
orderinfo(orderspot,1) = xx
orderinfo(orderspot,2) = yy
orderinfo(orderspot,3) = cell(xx,yy)
orderspot = orderspot + 1
' comp.tests = comp.tests + 1
' #g "font courrier_new 10"
' #g "place 60 ";WindowHeight-40;";|";comp.tests;"         "
' #g "font courrier_new ";sc/2
call resolve
scan
'--------------grid finished ?----------  direct coded to improve compute speed...
grille.finie = 1
for gy = 1 to 9
for gx = 1 to 9
if cell(gx,gy) = 0 then
grille.finie = 0 :exit for
end if
next
if grille.finie = 0 then exit for
next
if grille.finie then exit sub
'---------------------------------------
'if grid.finished() then exit sub
cell(xx,yy) = nbre.tamp
end if
next
exit sub
end if
next
next
end sub

'**************************************************************************************************

Function grid.finished()  'grid finished ?
grid.finished = 1
for fy = 1 to 9
for fx = 1 to 9
if cell(fx,fy) = 0 then grid.finished = 0 :exit function
next
next
end function

Function grid.empty()   'grid totally empty ?
grid.empty = 1
for ey = 1 to 9
for ex = 1 to 9
if cell(ex,ey) > 0 then grid.empty = 0 :exit function
next
next
end function

Function ok(nbre,x,y)  'is nbre is possible in cell(x,y) ?
string\$ = "" :ok = 1
for c = 1 to 9
string\$ = string\$+" "+str\$(c)+str\$(y)+" "
next
for c = 1 to 9
string\$ = string\$+" "+str\$(x)+str\$(c)+" "
next
dx = 1*(x<4)+4*(x>3 and x<7)+7*(x>6)  'corner up/left of one of the nine big square
dy = 1*(y<4)+4*(y>3 and y<7)+7*(y>6)
for iy = 0 to 2
for ix = 0 to 2
string\$ = string\$+" "+str\$(dx+ix)+str\$(dy+iy)+" "
next
next
DO
for cp = 1 to 27
cpx = val(left\$(word\$(string\$,cp),1))
cpy = val(right\$(word\$(string\$,cp),1))
if cell(cpx,cpy) = nbre then ok = 0 :exit function
next
LOOP UNTIL cp = 28
end function

sub affgrille
for y = 1 to 9
for x = 1 to 9
if cell(x,y) > 0 then
#g "backcolor ";bckcolor\$
#g "place ";offset+(x-1)*sc+sc/5+sc/8;" ";offset+(y-1)*sc+sc/2+sc/4;";|";cell(x,y)
else
#g "color ";bckcolor\$
#g "place ";offset+(x-1)*sc+4;" ";offset+(y-1)*sc+4;";boxfilled ";offset+(x-1)*sc+sc-4;" ";offset+(y-1)*sc+sc-4 'erase
#g "color black"
end if
next
next
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
end sub

sub drawcube
#g "fill ";bckcolor\$
#g "backcolor black; color black"
#g "size 1"
for y = 1 to 9
for x = 1 to 9
#g "place ";offset+(x-1)*sc;" ";offset+(y-1)*sc
#g "box ";offset+(x-1)*sc+sc;" ";offset+(y-1)*sc+sc
next
next
#g "size 4" :scBig = 3 * sc
for yy = 1 to 3
for xx = 1 to 3
#g "place ";offset+(xx-1)*scBig;" ";offset+(yy-1)*scBig
#g "box ";offset+(xx-1)*scBig+scBig;" ";offset+(yy-1)*scBig+scBig
next
next
#g "backcolor ";bckcolor\$;"; color black"
#g "font courrier_new ";sc/2
#g "getbmp bckgrd 0 0 ";WindowWidth;" ";WindowHeight
#g "background bckgrd"
end sub

sub makeSprite
#g "size 5"
#g "place 2 2"
#g "box ";sc+2;" ";sc+2
#g "backcolor black"
#g "place 2 ";sc+2
#g "boxfilled ";sc+2;" ";2*sc+2
#g "color red"
#g "place 2 ";sc+4
#g "box ";sc+2;" ";2*sc+2
#g "getbmp square 0 0 ";sc+4;" ";2*(sc+4)-4
bmpsave "square" , "square.bmp"
end sub

sub quit handle\$
if grid.finished() = 0 and grid.empty() = 0 then
confirm "Save ?"; sav\$
if sav\$ = "yes" then call Save
end if
close #g
END
end sub``````