problem code regarding sudoku solver

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

problem code regarding sudoku solver

Post by TyCamden »

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.load, "Load", Load, UL, 400, 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 "addsprite square square"
    #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 "flush; discard"
        #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 "flush; discard"
        #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 "flush; discard"
        #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 "flush; discard"
        #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

    sub Load handle$
        FILEDIALOG "Load grid", "*.gri", fileName$
        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
        #g "flush; discard"
        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
        #g "flush; discard"
        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"
                #g "flush; discard"
            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"
        #g "flush; discard"
    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"
        #g "flush; discard"
    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