Const VERSION$ = "1.1"
Global coderName$ = "Firstdeathmaker"
AppTitle("SudokuCreator "+VERSION)

;Global Var's
Dim sudoku(8,8);sudoku field, 0-8 x 0-8 (=3x3 fields)
Dim sudoku_storeArr(8,8)
Global mx#,my#;mouse x and y position
Global sudoku_selx%,sudoku_sely%;selected field x and y coordinates
Global help%;if it shall show the help menue
Global lastAttemp$;used to display last solve attemp time



;################################
;DEINE GLOBALEN VARIABLEN
Dim sudoku_killerArr(8,8,9)
Global sudoku_killerSolutions%
Global sudoku_killerMaxSolutions%;how many solutions maximal shall be searched bevore exiting function
Global sudoku_killerDebugcounter%

Dim sudoku_createArr(8,8,9)
Global sudoku_createStep%

;################################

Main()

;################################
;Ab hier deine Implementation:

Function sudoku_solve()
   sudoku_killer()
   a = a
End Function

;returns false if Sudoku_solved() function is not working properly
Function test_solveFunction()
   Cls
   LastAttemp = "testing..."
   sudoku_draw()
   Flip 0
   Local accTime% = 0
   Local testrounds% = 100
   Local testriddles% = 100
   
   For i=1 To testriddles
      If sudoku_load("save\sudoku"+i+".sud")
         Cls
         LastAttemp = "testing sudoku "+i+" "+accTime/Float((i-1)*testrounds)
         sudoku_draw()
         Flip 0
         sudoku_store()
         time = MilliSecs()
            For i2=1 To testrounds
               sudoku_restore()
               sudoku_solve()
            Next
         accTime = accTime + (MilliSecs() - time)
         If Not Sudoku_solved() Return False
      EndIf
   Next
   
   sudoku_clear()
   
   
   result# = accTime/Float(testriddles*testrounds)
   
   LastAttemp = "one call took "+result+" ms!"
   Return True
End Function

;mass test, with loads of different random generated riddles (bad for comparison)
Function test_solveFunction2()
   Cls
   LastAttemp = "testing..."
   sudoku_draw()
   Flip 0
   Local accTime# = 0
   Local testrounds% = 10
   Local testriddles% = 100
   
   For i=1 To testriddles
      sudoku_create()
      Cls
      LastAttemp = "testing sudoku "+i+" "+accTime/Float(i-1)
      sudoku_draw()
      Flip 0
      sudoku_store()
      time = MilliSecs()
         For i2=1 To testrounds
            sudoku_restore()
            sudoku_solve()
         Next
      accTime = accTime + ((MilliSecs() - time) / Float(testrounds))
      If Not Sudoku_solved() Return False
   Next
   
   sudoku_clear()
   
   accTime = accTime/Float(testriddles)
   
   LastAttemp = "one call took "+accTime+" ms!"
   Return True
End Function




;Löst ein sudoku-Rätsel
;gibt Anzahl der gefundenen möglichen Lösungen zurück
Function sudoku_killer(justSolve=1);high optimized solve function
   Local time = MilliSecs()
   ;init killer Array
   For x=0 To 8
   For y=0 To 8
      sudoku_killerArr(x,y,0) = 9
      For i=1 To 9
         sudoku_killerArr(x,y,i) = 0
      Next
   Next
   Next

   sudoku_killerSolutions = 0
   If justSolve = 1;just solve mode
      sudoku_killerMaxSolutions = 1
   ElseIf justSolve = 0;is there more than one solution mode?
      sudoku_killerMaxSolutions = 2
   ElseIf justSolve = 2;find almost all solutions (boundary at 1000)
      sudoku_killerMaxSolutions = 10
   EndIf
   
   For x=0 To 8
   For y=0 To 8
      If sudoku(x,y) sudoku_killerSet(x,y,sudoku(x,y))
   Next
   Next
   
   ;start subroutine
   sudoku_killerBasic()
   Return sudoku_killerSolutions
End Function

Function sudoku_killerBasic()
   Local bestx = 0
   Local besty = 0
   Local bestValue = 10
   ;get best
   For x = 0 To 8
   For y = 0 To 8
      If sudoku(x,y)=0
         If sudoku_killerArr(x,y,0)<bestValue
            bestx = x
            besty = y
            bestValue = sudoku_killerArr(x,y,0)
         EndIf
      EndIf
   Next
   Next
   
   If bestx = 0
   If besty = 0
      If sudoku(bestx,besty)
         sudoku_killerSolutions = sudoku_killerSolutions + 1
         If sudoku_killerMaxSolutions>sudoku_killerSolutions Return False
         Return True ;finished
      EndIf
   EndIf
   EndIf
   
   If sudoku_killerArr(bestx,besty,0) = 0 Return False;not valid twig of backtracking
   
   For i=1 To 9
      If sudoku_killerArr(bestx,besty,i)=0
         sudoku_killerSet(bestx,besty,i)
         If sudoku_killerBasic()
            If sudoku_killerMaxSolutions = 1
               Return True
            Else
               sudoku_killerReset(bestx,besty)
               Return True
            EndIf
         EndIf
         sudoku_killerReset(bestx,besty)
      EndIf
   Next
   Return False ;no solution was found...
End Function

Function sudoku_killerSet(x,y,number)
   Local bx = Floor(x/3)*3
   Local by = Floor(y/3)*3
   ;3x3 field
   For xi=0 To 2
   For yi=0 To 2
      Local lx = bx + xi
      Local ly = by + yi
      sudoku_killerAdd(lx,ly,number)
   Next
   Next
   ;lines
   For i=0 To 8
      If i<>x sudoku_killerAdd(i,y,number)
      If i<>y sudoku_killerAdd(x,i,number)
   Next
   ;set number
   sudoku(x,y) = number
End Function

Function sudoku_killerReset(x,y)
   Local number = sudoku(x,y)
   Local bx = Floor(x/3)*3
   Local by = Floor(y/3)*3
   ;3x3 field
   For xi=0 To 2
   For yi=0 To 2
      Local lx = bx + xi
      Local ly = by + yi
      sudoku_killerRemove(lx,ly,number)
   Next
   Next
   ;lines
   For i=0 To 8
      If i<>x sudoku_killerRemove(i,y,number)
      If i<>y sudoku_killerRemove(x,i,number)
   Next
   ;reset number
   sudoku(x,y) = 0
End Function

Function sudoku_killerAdd(x,y,number)
   If sudoku_killerArr(x,y,number) = 0 sudoku_killerArr(x,y,0) = sudoku_killerArr(x,y,0) - 1 ;decrease numbers open counter
   sudoku_killerArr(x,y,number) = sudoku_killerArr(x,y,number) + 1
End Function

Function sudoku_killerRemove(x,y,number)
   sudoku_killerArr(x,y,number) = sudoku_killerArr(x,y,number) - 1
   If sudoku_killerArr(x,y,number) = 0 sudoku_killerArr(x,y,0) = sudoku_killerArr(x,y,0) + 1 ;increase numbers open counter
End Function



;Ende deiner Implementation
;###################################






;###################################
;Implementation Sudoku Creator

Function sudoku_createCollection(nr)
   CreateDir("save")
   For i=1 To nr
      Repeat
         sudoku_clear()
         solutions = sudoku_create()
         If solutions = 1
            If sudoku_save("save/sudoku"+i+".sud")
               Cls
               LastAttemp = "saving sudoku "+i
               sudoku_draw()
               Flip 0
            EndIf
         EndIf
      Until solutions = 1
   Next
End Function

Function sudoku_create()
   sudoku_clear()
   ;init create Array
   For x=0 To 8
   For y=0 To 8
      sudoku_createArr(x,y,0) = 9
      For i=1 To 9
         sudoku_createArr(x,y,i) = 0
      Next
   Next
   Next
   For x=0 To 8
   For y=0 To 8
      If sudoku(x,y) sudoku_createSet(x,y,sudoku(x,y))
   Next
   Next
   
   ;start subroutine
   sudoku_createSub()
   sudoku_createRandCleanup(80)
   sudoku_createCleanup()
   Return sudoku_killer(2) ;return number of solutions
End Function

;deletes up to "number" numbers from the sudoku (without making it to an 2-solutions possible sudoku)
Function sudoku_createRandCleanup(number)
   For i=1 To number
      x = Rand(0,8)
      y = Rand(0,8)
      value = sudoku(x,y)
      If value
         sudoku_createReset(x,y)
         If sudoku_killer(False)>1
            sudoku_createSet(x,y,value)
         EndIf
      EndIf
   Next
End Function

Function sudoku_createCleanup()
   For x = 0 To 8
   For y = 0 To 8
      value = sudoku(x,y)
      If value
         sudoku_createReset(x,y)
         If sudoku_killer(False)>1
            sudoku_createSet(x,y,value)
         EndIf
      EndIf
   Next
   Next
End Function

Function sudoku_createSub()
   Local bestx = 0
   Local besty = 0
   Local bestValue = 10
   ;get best
   For x = 0 To 8
   For y = 0 To 8
      If sudoku(x,y)=0
         If sudoku_createArr(x,y,0)<bestValue
            bestx = x
            besty = y
            bestValue = sudoku_createArr(x,y,0)
         EndIf
      EndIf
   Next
   Next
   
   If bestx = 0
   If besty = 0
      If sudoku(bestx,besty)
         Return True
      EndIf
   EndIf
   EndIf
   
   If sudoku_createArr(bestx,besty,0) = 0 Return False;not valid twig of backtracking


   x = bestx
   y = besty

   ;If sudoku_solve(False) = 1 Return True ;just one single solution possible
   
   If sudoku(x,y)
      If sudoku_createSub() Return True
      Return False
   EndIf
   

   ;first try to set to random value
   value = sudoku_getRandFreeValue(x,y)
   If value = 0 Return False
   sudoku_createSet(x,y,value)
   If sudoku_createSub() Return True
   sudoku_createReset(x,y)
   
   ;set to next value in queue
   For i=1 To 9
      If sudoku_createArr(x,y,i) = 0
         sudoku_createSet(x,y,i)
         If sudoku_createSub() Return True
         sudoku_createReset(x,y)
      EndIf
   Next
   Return False
End Function


Function sudoku_getRandFreeValue(x,y)
   If sudoku_createArr(x,y,0) < 1 Return 0;error, already filled
   choice = Rand(1,sudoku_createArr(x,y,0))
   For i=1 To 9
      If sudoku_createArr(x,y,i) = 0
         choice = choice - 1
         If choice = 0 Return i
      EndIf
   Next
End Function


Function sudoku_createSet(x,y,number)
   Local bx = Floor(x/3)*3
   Local by = Floor(y/3)*3
   ;3x3 field
   For xi=0 To 2
   For yi=0 To 2
      Local lx = bx + xi
      Local ly = by + yi
      sudoku_createAdd(lx,ly,number)
   Next
   Next
   ;lines
   For i=0 To 8
      If i<>x sudoku_createAdd(i,y,number)
      If i<>y sudoku_createAdd(x,i,number)
   Next
   ;set number
   sudoku(x,y) = number
End Function

Function sudoku_createReset(x,y)
   Local number = sudoku(x,y)
   Local bx = Floor(x/3)*3
   Local by = Floor(y/3)*3
   ;3x3 field
   For xi=0 To 2
   For yi=0 To 2
      Local lx = bx + xi
      Local ly = by + yi
      sudoku_createRemove(lx,ly,number)
   Next
   Next
   ;lines
   For i=0 To 8
      If i<>x sudoku_createRemove(i,y,number)
      If i<>y sudoku_createRemove(x,i,number)
   Next
   ;reset number
   sudoku(x,y) = 0
End Function

Function sudoku_createAdd(x,y,number)
   If sudoku_createArr(x,y,number) = 0 sudoku_createArr(x,y,0) = sudoku_createArr(x,y,0) - 1 ;decrease numbers open counter
   sudoku_createArr(x,y,number) = sudoku_createArr(x,y,number) + 1
End Function

Function sudoku_createRemove(x,y,number)
   sudoku_createArr(x,y,number) = sudoku_createArr(x,y,number) - 1
   If sudoku_createArr(x,y,number) = 0 sudoku_createArr(x,y,0) = sudoku_createArr(x,y,0) + 1 ;increase numbers open counter
End Function







;Ende Implementation Sudoku Creator
;###################################







;AB HIER BITTE NICHTS MEHR VERÄNDERN
Function MAIN()
   ;INITIALISATION
   Graphics 310,310,16,2
   SetBuffer BackBuffer()
   ClsColor 255,255,255
   SetFont LoadFont("arial", 20,1)
   ;MAINLOOP
   Repeat
      mx = MouseX()
      my = MouseY()
       Cls
         sudoku_draw()
         sudoku_logic()
      Flip
   Until KeyHit(1)
   End
End Function

;LOGIC LOOP
Function Sudoku_logic()
   x = Floor((mx-20)/30.0)
   y = Floor((my-20)/30.0)
   
   If MouseHit(1) ;select field beneath mousepointer
      If x=>0 And x < 9
      If y=>0 And y < 9
         sudoku_selx = x
         sudoku_sely = y
         
      EndIf
      EndIf
   EndIf
   
   If KeyHit(200) And sudoku_sely>0 sudoku_sely = sudoku_sely - 1 ;decrease selected field y - coord
   If KeyHit(208) And sudoku_sely<9 sudoku_sely = sudoku_sely + 1 ;increase selected field y - coord
   If KeyHit(203) And sudoku_selx>0 sudoku_selx = sudoku_selx - 1 ;decrease selected field x - coord
   If KeyHit(205) And sudoku_selx<9 sudoku_selx = sudoku_selx + 1 ;increase selected field x - coord
   
   For i=2 To 10 ;write number (1-9) into selected field
      If KeyHit(i) sudoku(sudoku_selx,sudoku_sely) = i-1
   Next
   
   If KeyHit(11) Or KeyHit(211) sudoku(sudoku_selx,sudoku_sely) = 0 ;0 or DEL - delete current selected field
   
   If KeyHit(57);SPACE solve sudoku
      Cls
      Sudoku_draw()
      Text 135,1,"work in progress..."
      Flip 0
      If sudoku_valid()
         lastAttemp = MilliSecs()
         If Sudoku_killer()
            LastAttemp = "time: "+(MilliSecs() - Int(lastAttemp))
         Else
            LastAttemp = "no solution found"
         EndIf
      EndIf
   EndIf
   
   If KeyHit(46) ; key C - create single riddle
      Cls
      Sudoku_draw()
      Text 135,1,"work in progress..."
      Flip 0
      LastAttemp = "sudoku with "+sudoku_create()+" solution(s) created"
   EndIf
   
   If KeyHit(50);M - make riddle collection
      sudoku_createCollection(500)
   EndIf
   
   If KeyHit(49);N
      sudoku_clear() ;empty sudoku paper
      LastAttemp = ""
   EndIf
   
   If KeyHit(20);T
      If Not test_solveFunction() LastAttemp = "tested function not working"
      ;If Not test_solveFunction2() LastAttemp = "tested function not working"
   EndIf
   
   If KeyHit(59) help=Not help ;key F1
   
   If KeyHit(38) sudoku_load("save\sudoku1.sud") ;key l
   If KeyHit(31) sudoku_save("save.sud") ;key s
End Function

;RENDER LOOP, shows sudoku and helpmenü
Function Sudoku_draw()
   For x%=0 To 8
   For y%=0 To 8
      Local posx% = 20 + x * 30
      Local posy% = 20 + y * 30
      If sudoku_selx = x And sudoku_sely = y
         Color 255,200,100
         Rect posx,posy,31,31,1
      EndIf
      Color 0,0,0
      Rect posx,posy,31,31,0
      If sudoku(x,y) Text posx+15,posy+15,sudoku(x,y),1,1
   Next
   Next
   Color 0,0,0
   For i=0 To 1
      Line 111 + 90*i,20,111+90*i,290
      Line 20,111 + 90*i,290,111+90*i
   Next
   
   If Sudoku_solved()
      Text 20,1,"solved sudoku"
   ElseIf Sudoku_valid()
      Text 20,1,"valid sudoku"
   EndIf
   
   If LastAttemp<>""
      Text 155,290,LastAttemp,1,0
   EndIf
   
   If help
      Color 255,255,255
      Rect 40,40,230,230
      Color 0,0,0
      Rect 39,39,232,232,0
      Text 155,50,"Help",1,0
      Text 50,80,"Arrow Keys - select field"
      Text 50,100,"'1'-'9' - write number"
      Text 50,120,"'0' or 'Del' - clear number"
      Text 50,140,"'space' - solve sudoku"
      Text 50,160,"'n' clear sudoku field"
      Text 50,180,"'F1' toggle helpmenue"
      Text 155,240,"programmed by "+coderName,1
   EndIf
End Function

;Functions helping to manage SUDOKU

;Checks, if sudoku is solved
;@ return - true, if sudoku is solved correctly
Function Sudoku_solved()
   If Not Sudoku_valid() Return False
   For x=0 To 8
   For y=0 To 8
      If sudoku(x,y) = 0 Return False
   Next
   Next
   Return True
End Function

;checks, if sudoku is a valid sudoku
;@return true, if sudoku is valid, false if sudoku is not valid
Function Sudoku_valid()
   Local x[9]
   Local y[9]
   For bx=0 To 2
   For by=0 To 2
      For n=0 To 9
         x[n]=0
      Next
      For xi=0 To 2
      For yi=0 To 2
         Local lx = bx*3 + xi
         Local ly = by*3 + yi
         If sudoku(lx,ly)
            If x[sudoku(lx,ly)]
               Return False
            Else
               x[sudoku(lx,ly)]=True
            EndIf
         EndIf
      Next
      Next
   Next
   Next
   
   For i=0 To 8
      For n=0 To 9
         x[n]=0
         y[n]=0
      Next
   For i2=0 To 8
      If sudoku(i,i2)
         If x[sudoku(i,i2)]
            Return False
         Else
            x[sudoku(i,i2)]=True
         EndIf
      EndIf
      If sudoku(i2,i)
         If y[sudoku(i2,i)]
            Return False
         Else
            y[sudoku(i2,i)]=True
         EndIf
      EndIf
   Next
   Next
   Return True
End Function

;Clears sudoku field
Function sudoku_clear()
   For x%=0 To 8
   For y%=0 To 8
      sudoku(x,y) = 0
   Next
   Next
End Function

;Loads a sudoku
Function sudoku_load(filepath$)
   file = ReadFile(filepath)
   If Not file
      RuntimeError "error loading: "+filepath
      Return False
   EndIf
   For x=0 To 8
   For y=0 To 8
      sudoku(x,y) = ReadInt(file)
   Next
   Next
   CloseFile file
   Return True
End Function

;saves current sudoku
Function sudoku_save(filepath$)
   file = WriteFile(filepath)
   If Not file
      RuntimeError "error writing: "+filepath
      Return False
   EndIf
   For x=0 To 8
   For y=0 To 8
      WriteInt file,sudoku(x,y)
   Next
   Next
   CloseFile file
   Return True
End Function

;stores current sudoku in tmp array
Function sudoku_store()
   For x = 0 To 8
   For y = 0 To 8
      sudoku_storeArr(x,y) = sudoku(x,y)
   Next
   Next
End Function

;restores current sudoku in tmp array
Function sudoku_restore()
   For x = 0 To 8
   For y = 0 To 8
      sudoku(x,y) = sudoku_storeArr(x,y)
   Next
   Next
End Function