It is currently Wed Jul 08, 2020 2:47 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 3 posts ] 
Author Message
 Post subject: Su Doku Solver
PostPosted: Wed Jun 15, 2005 11:18 pm 
Offline
User
User

Joined: Wed Apr 30, 2003 2:25 pm
Posts: 60
Location: Västerås
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:
; 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



Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Jun 16, 2005 3:44 pm 
Offline
Enthusiast
Enthusiast

Joined: Mon May 10, 2004 7:37 pm
Posts: 103
Location: West Yorkshire, England
Nice one Johan. I love Su Doku :)

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

Cheers,
Jim


Top
 Profile  
Reply with quote  
 Post subject:
PostPosted: Thu Jun 16, 2005 3:49 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Mar 07, 2004 8:47 am
Posts: 1860
Location: Argentina
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.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 3 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 7 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye