I use it to solve the Kruskal's problem (ie find the minimum-spanning-tree graph).
Left click to see each step. See https://en.wikipedia.org/wiki/Kruskal%27s_algorithm
Tested on win10x64, PB5.62 x86.
Code: Select all
;/ this part is UNION-FIND DATA SET
;/
Procedure.l MakeSet(size.l)
If size<=0:MessageRequester("Error","MakeSet() can't get zero or negative argument"):ProcedureReturn 0:EndIf
size+1
*sizeID=AllocateMemory(size*8):If *sizeID=0:MessageRequester("Error","Allocate Memory SIZE can't make its job in MakeSet()"):ProcedureReturn 0:EndIf
PokeL(*sizeID,size)
For i=1 To size-1
PokeL(*sizeID+i*8,i)
PokeL(*sizeID+i*8+4,1)
Next i
ProcedureReturn *sizeID
EndProcedure
Procedure.l Find(*sizeID,p.l)
;Find the root of the component/set
root.l=p
While root<>PeekL(*sizeID+root*8)
root=PeekL(*sizeID+root*8)
Wend
;path Compression. Gives us amortized constant time complexity.
While p<>root
it.l=PeekL(*sizeID+p*8)
PokeL(*sizeID+p*8,root)
p=it
Wend
ProcedureReturn root
EndProcedure
Procedure Connected(*sizeID,p.l,q.l)
If find(*sizeID,p)=find(*sizeID,q):ProcedureReturn 1:EndIf
ProcedureReturn 0
EndProcedure
Procedure Unify(*sizeID,p.l,q.l)
root1.l=find(*sizeID,p)
root2.l=find(*sizeID,q)
If root1=root2:ProcedureReturn 0:EndIf ;same group
sizeR1.l=PeekL(*sizeID+root1*8+4)
sizeR2.l=PeekL(*sizeID+root2*8+4)
If sizeR1<sizeR2
PokeL(*sizeID+root2*8+4,sizeR1+SizeR2)
PokeL(*sizeID+root1*8,root2)
Else
PokeL(*sizeID+root1*8+4,sizeR1+SizeR2)
PokeL(*sizeID+root2*8,root1)
EndIf
nb.l=PeekL(*sizeID)-1
PokeL(*sizeID,nb)
EndProcedure
;/ This PART is data for the Kruskal's problem
;/ https://en.wikipedia.org/wiki/Kruskal%27s_algorithm
#NbPoints=10
Procedure debugSet(*sizeID)
ClearDebugOutput()
For i=1 To #NbPoints
Debug Chr(64+i)+" Groupe "+find(*sizeID,i)
Next i
EndProcedure
Structure link
PointA.l
PointB.l
Cost.l
final.l
EndStructure
Structure pts
x.l
y.l
Name.s
EndStructure
Global NewList Link.link()
Dim Points.pts(#NbPoints)
Procedure AddLink(pointA,PointB,Cost)
AddElement(Link())
Link()\PointA=pointA
Link()\PointB=pointB
Link()\Cost=Cost
EndProcedure
Addlink(1,2,5) ;AB 5
Addlink(1,4,9) ;AD 5
Addlink(1,5,1) ;AE 1
Addlink(2,4,2) ;BD 2
Addlink(2,3,4) ;BC 4
Addlink(3,10,8);CJ 8
Addlink(3,9,1) ;CI 1
Addlink(3,8,4) ;CH 4
Addlink(4,5,2) ;DE 2
Addlink(4,6,5) ;DF 5
Addlink(4,7,11);DG 11
Addlink(4,8,2) ;DH 2
Addlink(5,6,1) ;EF 1
Addlink(6,7,7) ;FG 7
Addlink(7,8,1) ;GH 1
Addlink(7,9,4) ;GI 4
Addlink(8,9,6) ;HI 6
Addlink(9,10,0);IJ 0
SortStructuredList(Link(),#PB_Sort_Ascending ,OffsetOf(link\cost),TypeOf(link\cost))
For i=1 To #NbPoints
Points(i)\Name=Chr(64+i)
Read.i Points(i)\x
Points(i)\x=Points(i)\x*100+Random(50)-25
Read.i Points(i)\y
Points(i)\y=Points(i)\y*80
Next i
*mem=MakeSet(#NbPoints)
If OpenWindow(0, 0, 0, 800, 600, "Kruskal problem, solved with Union-Find data structure", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0:End:EndIf
CanvasGadget(0, 0, 0, 800, 600, #PB_Canvas_Container)
CloseGadgetList()
CreateImage(0,800,600)
CurrentEdge=0
Repeat
Event = WaitWindowEvent()
If Event = #PB_Event_Gadget
If EventType()=#PB_EventType_LeftButtonDown Or CurrentEdge=0
If SelectElement(Link(),CurrentEdge)
If Connected(*mem,link()\PointA,link()\PointB)=0
Unify(*mem,link()\PointA,link()\PointB)
link()\final=1
debugSet(*mem)
Else
link()\final=2
EndIf
Else
MessageRequester("Info","Kuskal's problem is solved, this is the minimum-spanning-tree graph")
EndIf
CurrentEdge+1
StartDrawing(ImageOutput(0))
Box(0,0,800,600,#Black)
DrawText(0,0,"[Clic left] to examin next nodes")
ForEach Link()
ptA.l=link()\PointA
ptB.l=link()\PointB
If link()\final=1
LineXY(Points(ptA)\x,Points(ptA)\y,Points(ptB)\x,Points(ptB)\y,$28ACE2)
DrawText((Points(ptB)\x-Points(ptA)\x)/2+Points(ptA)\x,(Points(ptB)\y-Points(ptA)\y)/2+Points(ptA)\y,Str(link()\Cost))
ElseIf link()\final=0
LineXY(Points(ptA)\x,Points(ptA)\y,Points(ptB)\x,Points(ptB)\y,#White)
DrawText((Points(ptB)\x-Points(ptA)\x)/2+Points(ptA)\x,(Points(ptB)\y-Points(ptA)\y)/2+Points(ptA)\y,Str(link()\Cost))
ElseIf link()\final=2
LineXY(Points(ptA)\x,Points(ptA)\y,Points(ptB)\x,Points(ptB)\y,#Black)
EndIf
Next
DrawingMode(#PB_2DDrawing_Transparent)
For i=1 To #NbPoints
Circle(Points(i)\x,points(i)\y,12,#Blue)
DrawText(Points(i)\x-TextWidth(points(i)\Name)/2,points(i)\y-TextHeight(points(i)\Name)/2,points(i)\Name,#White)
Next i
StopDrawing()
StartDrawing(CanvasOutput(0))
DrawImage(ImageID(0),0,0)
StopDrawing()
EndIf
EndIf
Until Event = #PB_Event_CloseWindow
FreeMemory(*mem)
;points coordonnates to display
DataSection
Data.i 1,1,2,1,4,1 ;ABC
Data.i 2,2,1,2 ;DE
Data.i 1,3,2,3 ;FG
Data.i 3,2 ;H
Data.i 3,3,4,3 ;IJ
EndDataSection