Su Doku Solver
Posted: Wed Jun 15, 2005 11:18 pm
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.
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