# PureBasic Forum

 It is currently Tue Apr 13, 2021 4:48 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 3 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Su Doku SolverPosted: Wed Jun 15, 2005 11:18 pm
 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
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

ProcedureReturn  x + (y-1)*9
EndProcedure

Procedure GetLoc(x.w, y.w)
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
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
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")
For a = 0 To 8
TextGadget(87 + a, 180, 64 + a*11, 90, 11, "")
Next
StringGadget(86, 0, 180, 260, 20, "")

Repeat
Event = WaitWindowEvent()
Case 83
Checkit()
SolveIt()
For a = 0 To 8
Next
Case 84
Repeat
For a = 0 To 8
Next
Checkit()
Until SolveIt() = 0
Case 85
For x = 1 To 9
For y = 1 To 9
If txt.w > 0
Else
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

 Post subject: Posted: Thu Jun 16, 2005 3:44 pm
 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

 Post subject: Posted: Thu Jun 16, 2005 3:49 pm

Joined: Sun Mar 07, 2004 8:47 am
Posts: 1861
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

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 3 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: highend and 15 guests

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

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite