Page 1 of 1

Su Doku Solver

Posted: Wed Jun 15, 2005 11:18 pm
by Johan_Haegg
Code updated For 5.20+

So, here is yet another game the computer beats us in.
Wrote this piece of code while working on a su doku generator/game.
I just had to write it when i came up with the idea to use OR to check
wich numbers could not be used.
Will probably release the finished product here in a few weeks.
It should be easy to extend this to work with nonstandard grid sizes.

Code: Select all

; Su Doku Solver 0.2 for PureBasic 3.93 by Johan Hägg, 2005
; Very simple algorithm, cant even do slicing but feel free to implement.
; This sourcecode may not be used in commercial applications.
; Example for Load Row:" 3   7  46 2 41    5  3 967 4   3  6 87   35 9  7   2 718 2  4    16 8 94  5   3 " (use w/o "")

Global Dim Num.w(9)
Global Dim Row.w(9)
Global Dim Col.w(9)
Global Dim Block.w(9)
Global All.s
Global Answer.w
Num(1) = %000000001
Num(2) = %000000010
Num(3) = %000000100
Num(4) = %000001000
Num(5) = %000010000
Num(6) = %000100000
Num(7) = %001000000
Num(8) = %010000000
Num(9) = %100000000


Procedure GetGadget(x.w,y.w)
  ProcedureReturn  x + (y-1)*9
EndProcedure

Procedure GetLoc(x.w, y.w)
  ProcedureReturn Val(GetGadgetText(x + (y-1)*9))
EndProcedure

Procedure GetBlock(x.w, y.w)
  ProcedureReturn (Round(y/3,1)-1)*3 + Round(x/3,1)
EndProcedure

Procedure BuildRow(RowC.w)
  Row(RowC.w) = 0
  For x.w = 1 To 9
    Value.w = Num(GetLoc(x.w, RowC.w))
    If Row(RowC.w) & Value.w
      MessageRequester("Duplicate", "Duplicate found at " + Str(x) + ":" + Str(RowC))
      Break
    Else
      Row(RowC.w) = Row(RowC.w) | Value.w
    EndIf
  Next
EndProcedure

Procedure BuildColumn(ColC.w)
  Col(ColC.w) = 0
  For y.w = 1 To 9
    Value.w = Num(GetLoc(ColC.w, y.w))
    If Col(ColC.w) & Value.w
      MessageRequester("Duplicate", "Duplicate found at " + Str(ColC.w) + ":" + Str(y.w))
      Break
    Else
      Col(ColC.w) = Col(ColC.w) | Value.w
    EndIf
  Next
EndProcedure

Procedure BuildBlocks()
  For b = 1 To 9
    Block(b) = 0
  Next
  For x.w = 1 To 9
    For y.w = 1 To 9
      Value.w = Num(GetLoc(x.w,y.w))
      If Block(GetBlock(x.w, y.w)) & Value.w
        MessageRequester("Duplicate", "Duplicate found at " + Str(x.w) + ":" + Str(y.w))
        Break
      Else
        Block(GetBlock(x.w, y.w)) = Block(GetBlock(x.w, y.w)) | Value.w
      EndIf
    Next
  Next
EndProcedure

Procedure Solve(x.w, y.w)
  Disallow.w = Row(y.w) | Col(x.w) | Block(GetBlock(x.w, y.w))
  For cnum = 1 To 9
    If Num(cnum) & Disallow.w = 0
      Allowed + 1
      Answer = cnum
    EndIf
  Next
  ProcedureReturn Allowed
EndProcedure

Procedure SolveIt()
  All.s = " "
  For y = 1 To 9
    For x = 1 To 9
      chk = Solve(x,y)
      If GetLoc(x,y) = 0
        If chk = 1
          If solved = 0
            SetGadgetText(GetGadget(x,y), Str(Answer))
            solved = 1
          EndIf
        EndIf
        All.s + Str(chk)
        ac + 1
      Else
        All.s + " "
        ac + 1
      EndIf
      If ac = 3
        ac = 0
        All.s + " "
      EndIf
    Next
  Next
  ProcedureReturn solved
EndProcedure

Procedure Checkit()
  For row = 1 To 9
    BuildRow(row)
  Next
  For col = 1 To 9
    BuildColumn(col)
  Next
  BuildBlocks()
EndProcedure


OpenWindow(0, 0, 0, 260, 200, "Su Doku Solver", #PB_Window_SystemMenu)

For y = 0 To 8
  For x = 0 To 8
    p + 1
    StringGadget(p, x*20, y*20, 20, 20, "", #PB_String_Numeric)
  Next
Next
ButtonGadget(83, 180, 0, 80, 20, "Solve")
ButtonGadget(84, 180, 20, 80, 20, "AutoSolve")
ButtonGadget(85, 180, 40, 80, 20, "Load Row")
LoadFont(1, "Courier New", 8)
For a = 0 To 8
  TextGadget(87 + a, 180, 64 + a*11, 90, 11, "")
  SetGadgetFont(87 + a, FontID(1))
Next
StringGadget(86, 0, 180, 260, 20, "")

Repeat
  Event = WaitWindowEvent()
  If Event = #PB_Event_Gadget
    Select EventGadget()
      Case 83
        Checkit()
        SolveIt()
        For a = 0 To 8
          SetGadgetText(87+a, Mid(All.s, a*12+2, 12))
        Next
      Case 84
        Repeat
          For a = 0 To 8
            SetGadgetText(87+a, Mid(All.s, a*12+2, 12))
          Next
          Checkit()
        Until SolveIt() = 0
      Case 85
        For x = 1 To 9
          For y = 1 To 9
            txt.w = Val(Mid(GetGadgetText(86), GetGadget(x, y), 1))
            If txt.w > 0
              SetGadgetText(GetGadget(x,y), Str(txt))
            Else
              SetGadgetText(GetGadget(x,y), "")
            EndIf
          Next
        Next
    EndSelect
  EndIf
  If Event = #PB_Event_Repaint
    StartDrawing(WindowOutput(0))
    Line(59, 0, 0, 180, 255)
    Line(119, 0, 0, 180, 255)
    Line(0, 59, 180, 0, 255)
    Line(0, 119, 180, 0, 255)
    StopDrawing()
  EndIf
  
Until Event = #PB_Event_CloseWindow


Posted: Thu Jun 16, 2005 3:44 pm
by Jimbo_H
Nice one Johan. I love Su Doku :)

Thanks for posting the code, I'm looking forward to the finished version.

Cheers,
Jim

Posted: Thu Jun 16, 2005 3:49 pm
by dagcrack
Very nice, you should however limit the amount of given data into each field, else you could get with an out of bounds array if im not wrong.