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