361 lines
10 KiB
OpenEdge ABL
361 lines
10 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "API_GraphOrdering"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
' ======= Graph sorting and ordering facilities =====
|
|
' Shared module version: 20210422
|
|
' Tested in: TestCommons
|
|
' Depends on: ex_Collection, CDS_Graph, API_LinkedComponents
|
|
' Required reference: Scripting
|
|
Option Explicit
|
|
|
|
Private graph_ As CDS_Graph
|
|
Private nodes_ As Collection
|
|
Private sourceOrder_ As Scripting.Dictionary ' Map of (nodeID, globalIndex)
|
|
Private nodeComponents_ As Scripting.Dictionary ' Map of (nodeID, componentIndex)
|
|
Private componentCount_ As Long
|
|
|
|
Private status_ As Scripting.Dictionary
|
|
Private ranks_ As Scripting.Dictionary
|
|
|
|
Private Const MAX_NODE_INDEX& = 100000
|
|
Private Const RANK_UNDEF = -1
|
|
|
|
Private Enum TVisitStatus
|
|
T_STATUS_UNVISITED = 0
|
|
T_STATUS_VISITING = 1
|
|
T_STATUS_VISITED = 2
|
|
End Enum
|
|
|
|
Public Function Init(iGraph As CDS_Graph)
|
|
Call SetGraph(iGraph)
|
|
End Function
|
|
|
|
' Classic topological order (no edges pointing backward in order)
|
|
Public Function TopologicalOrder() As Collection
|
|
Set sourceOrder_ = Nothing
|
|
Set TopologicalOrder = RevertCollection(DefaultOrder)
|
|
End Function
|
|
|
|
' Reversed topological order
|
|
Public Function ReverseTopologicalOrder() As Collection
|
|
Set sourceOrder_ = Nothing
|
|
Set ReverseTopologicalOrder = DefaultOrder
|
|
End Function
|
|
|
|
' Topological order where linked components are grouped together
|
|
Public Function TopologicalComponentOrder() As Collection
|
|
Set sourceOrder_ = Nothing
|
|
Dim iOrder As Collection: Set iOrder = RevertCollection(DefaultOrder)
|
|
Set TopologicalComponentOrder = GroupNodesDefault(iOrder)
|
|
End Function
|
|
|
|
' Reversed topological order where linked components are grouped together
|
|
Public Function ReverseTopologicalComponentOrder() As Collection
|
|
Set sourceOrder_ = Nothing
|
|
Dim iOrder As Collection: Set iOrder = DefaultOrder
|
|
Set ReverseTopologicalComponentOrder = GroupNodesDefault(iOrder)
|
|
End Function
|
|
|
|
' Sort topologically using BFS and ordering according to input
|
|
' Note: elements not present in the graph are excluded from output
|
|
Public Function SortLayers(iSourceOrder As Collection) As Collection
|
|
If iSourceOrder.Count = 0 Then
|
|
Set SortLayers = New Collection
|
|
Exit Function
|
|
End If
|
|
|
|
Call InitSourceOrder(iSourceOrder)
|
|
Dim iNodesOrder As Collection: Set iNodesOrder = InduceWidthOrder
|
|
Dim iComponents As Collection: Set iComponents = SortComponents(iNodesOrder)
|
|
Set SortLayers = GroupNodesInduced(iNodesOrder, iComponents)
|
|
End Function
|
|
|
|
' Sort topologically using DFS and ordering according to input
|
|
' Note: elements not present in the graph are excluded from output
|
|
Public Function SortDeep(iSourceOrder As Collection) As Collection
|
|
If iSourceOrder.Count = 0 Then
|
|
Set SortDeep = New Collection
|
|
Exit Function
|
|
End If
|
|
|
|
Call InitSourceOrder(iSourceOrder)
|
|
Dim iNodesOrder As Collection: Set iNodesOrder = InduceDepthOrder
|
|
Dim iComponents As Collection: Set iComponents = SortComponents(iNodesOrder)
|
|
Set SortDeep = GroupNodesInduced(iNodesOrder, iComponents)
|
|
End Function
|
|
|
|
' ==============
|
|
Private Function SetGraph(iGraph As CDS_Graph)
|
|
Set graph_ = iGraph
|
|
Set nodes_ = graph_.Nodes
|
|
Dim iProcessor As New API_LinkedComponents
|
|
Set nodeComponents_ = iProcessor.GetComponents(graph_)
|
|
componentCount_ = iProcessor.CountComponents
|
|
End Function
|
|
|
|
Private Function DefaultOrder()
|
|
Dim iOrder As New Collection
|
|
|
|
Call InitStatus
|
|
|
|
Dim iStack As Collection
|
|
Dim vNode As Variant
|
|
For Each vNode In nodes_
|
|
If status_(vNode) <> T_STATUS_UNVISITED Then _
|
|
GoTo NEXT_NODE
|
|
Set iStack = New Collection: Call iStack.Add(vNode)
|
|
Do While iStack.Count > 0
|
|
Dim vItem As Variant: vItem = iStack.Item(iStack.Count)
|
|
If status_(vItem) = T_STATUS_UNVISITED Then
|
|
status_(vItem) = T_STATUS_VISITING
|
|
Dim vChild As Variant
|
|
For Each vChild In graph_.nodes_(vItem).outputs_
|
|
If status_(vChild) = T_STATUS_UNVISITED Then _
|
|
Call iStack.Add(vChild)
|
|
Next vChild
|
|
Else
|
|
Call iStack.Remove(iStack.Count)
|
|
If status_(vItem) <> T_STATUS_VISITED Then
|
|
status_(vItem) = T_STATUS_VISITED
|
|
Call iOrder.Add(vItem)
|
|
End If
|
|
End If
|
|
Loop
|
|
NEXT_NODE:
|
|
Next vNode
|
|
|
|
Set DefaultOrder = iOrder
|
|
End Function
|
|
|
|
Private Function InduceWidthOrder() As Collection
|
|
Dim iOrder As New Collection
|
|
|
|
Call InitRanks
|
|
|
|
Dim iQueue As Collection: Set iQueue = New Collection
|
|
Dim iKnown As New Scripting.Dictionary
|
|
Dim vNode As Variant
|
|
For Each vNode In CompleteInducedOrder
|
|
If ranks_(vNode) = 1 Then
|
|
Call iQueue.Add(vNode)
|
|
Call iKnown.Add(vNode, 0)
|
|
End If
|
|
Next vNode
|
|
|
|
Do While iQueue.Count > 0
|
|
vNode = iQueue.Item(1)
|
|
Call iQueue.Remove(1)
|
|
Call iOrder.Add(vNode)
|
|
|
|
If graph_.nodes_(vNode).outputs_.Count > 0 Then
|
|
Dim vChildren() As Variant: vChildren = ToArray(graph_.nodes_(vNode).outputs_)
|
|
Call SortChildren(vChildren)
|
|
Dim vChild As Variant
|
|
For Each vChild In vChildren
|
|
If Not iKnown.Exists(vChild) Then
|
|
If ranks_(vChild) = ranks_(vNode) + 1 Then
|
|
Call iQueue.Add(vChild)
|
|
Call iKnown.Add(vChild, 0)
|
|
End If
|
|
End If
|
|
Next vChild
|
|
End If
|
|
Loop
|
|
|
|
Set InduceWidthOrder = iOrder
|
|
End Function
|
|
|
|
Private Function InduceDepthOrder() As Collection
|
|
Dim iOrder As New Collection
|
|
|
|
Call InitRanks
|
|
|
|
Dim iStack As Collection: Set iStack = New Collection
|
|
Dim iKnown As New Scripting.Dictionary
|
|
Dim vNode As Variant
|
|
For Each vNode In RevertCollection(CompleteInducedOrder)
|
|
If ranks_(vNode) = 1 Then
|
|
Call iStack.Add(vNode)
|
|
End If
|
|
Next vNode
|
|
|
|
Dim vChildren() As Variant
|
|
Dim vChild As Variant
|
|
Dim nChild&
|
|
Do While iStack.Count > 0
|
|
vNode = iStack.Item(iStack.Count)
|
|
Call iStack.Remove(iStack.Count)
|
|
If iKnown.Exists(vNode) Then _
|
|
GoTo NEXT_ITEM
|
|
|
|
Call iOrder.Add(vNode)
|
|
Call iKnown.Add(vNode, 0)
|
|
|
|
If graph_.nodes_(vNode).outputs_.Count > 0 Then
|
|
vChildren = ToArray(graph_.nodes_(vNode).outputs_)
|
|
Call SortChildren(vChildren)
|
|
For nChild = UBound(vChildren) To LBound(vChildren) Step -1
|
|
vChild = vChildren(nChild)
|
|
If Not iKnown.Exists(vChild) Then _
|
|
Call iStack.Add(vChild)
|
|
Next nChild
|
|
End If
|
|
NEXT_ITEM:
|
|
Loop
|
|
|
|
Set InduceDepthOrder = iOrder
|
|
End Function
|
|
|
|
Private Function InitStatus()
|
|
Set status_ = New Scripting.Dictionary
|
|
Dim vNode As Variant
|
|
For Each vNode In nodes_
|
|
status_(vNode) = T_STATUS_UNVISITED
|
|
Next vNode
|
|
End Function
|
|
|
|
Private Function InitRanks()
|
|
Call InitStatus
|
|
|
|
Set ranks_ = New Scripting.Dictionary
|
|
Dim vNode As Variant
|
|
For Each vNode In CompleteInducedOrder
|
|
ranks_(vNode) = RANK_UNDEF
|
|
Next vNode
|
|
|
|
For Each vNode In nodes_
|
|
Call PropagateRank(vNode, 1)
|
|
Next vNode
|
|
End Function
|
|
|
|
Private Function PropagateRank(vNode As Variant, nRank&)
|
|
If ranks_(vNode) >= nRank Then _
|
|
Exit Function
|
|
ranks_(vNode) = nRank
|
|
|
|
If graph_.nodes_(vNode).outputs_.Count = 0 Then _
|
|
Exit Function
|
|
|
|
status_(vNode) = T_STATUS_VISITING
|
|
|
|
Dim vChildren() As Variant: vChildren = ToArray(graph_.nodes_(vNode).outputs_)
|
|
Call SortChildren(vChildren)
|
|
Dim vChild As Variant
|
|
For Each vChild In vChildren
|
|
If status_(vChild) <> T_STATUS_VISITING Then _
|
|
Call PropagateRank(vChild, nRank + 1)
|
|
Next vChild
|
|
|
|
status_(vNode) = T_STATUS_VISITED
|
|
End Function
|
|
|
|
Private Function InitSourceOrder(iSourceOrder As Collection)
|
|
Set sourceOrder_ = New Scripting.Dictionary
|
|
Dim aVal As Variant
|
|
Dim nIndex&: nIndex = 1
|
|
For Each aVal In iSourceOrder
|
|
If graph_.HasNode(aVal) Then
|
|
sourceOrder_(aVal) = nIndex
|
|
nIndex = nIndex + 1
|
|
End If
|
|
Next aVal
|
|
End Function
|
|
|
|
Private Function CompleteInducedOrder() As Collection
|
|
Dim iOrder As New Collection
|
|
Dim vItem As Variant
|
|
For Each vItem In sourceOrder_
|
|
Call iOrder.Add(vItem)
|
|
Next vItem
|
|
|
|
If iOrder.Count = graph_.Size Then
|
|
Set CompleteInducedOrder = iOrder
|
|
Exit Function
|
|
End If
|
|
|
|
For Each vItem In nodes_
|
|
If Not sourceOrder_.Exists(vItem) Then _
|
|
Call iOrder.Add(vItem)
|
|
Next vItem
|
|
|
|
Set CompleteInducedOrder = iOrder
|
|
End Function
|
|
|
|
Private Function SortChildren(ByRef target() As Variant)
|
|
If UBound(target) < 1 Then _
|
|
Exit Function
|
|
Dim i&, j&
|
|
Dim vItem As Variant
|
|
For i = LBound(target) + 1 To UBound(target) Step 1
|
|
vItem = target(i)
|
|
Dim nIndex&: nIndex = GetNodeIndex(vItem)
|
|
j = i - 1
|
|
Do While j >= 0
|
|
If GetNodeIndex(target(j)) <= nIndex Then _
|
|
Exit Do
|
|
target(j + 1) = target(j)
|
|
j = j - 1
|
|
Loop
|
|
target(j + 1) = vItem
|
|
Next i
|
|
End Function
|
|
|
|
Private Function GroupNodesDefault(iNodes As Collection) As Collection
|
|
Dim iResult As New Collection
|
|
Dim nComponent&
|
|
For nComponent = 0 To componentCount_ - 1 Step 1
|
|
Dim vNode As Variant
|
|
For Each vNode In iNodes
|
|
If Not sourceOrder_ Is Nothing Then _
|
|
If Not sourceOrder_.Exists(vNode) Then _
|
|
GoTo NEXT_NODE
|
|
If nodeComponents_(vNode) = nComponent Then _
|
|
Call iResult.Add(vNode)
|
|
NEXT_NODE:
|
|
Next vNode
|
|
Next nComponent
|
|
Set GroupNodesDefault = iResult
|
|
End Function
|
|
|
|
Private Function GetNodeIndex(vNode As Variant) As Long
|
|
If sourceOrder_.Exists(vNode) Then
|
|
GetNodeIndex = sourceOrder_(vNode)
|
|
Else
|
|
GetNodeIndex = MAX_NODE_INDEX
|
|
End If
|
|
End Function
|
|
|
|
Private Function SortComponents(iNodesOrder As Collection) As Collection
|
|
Dim iOrder As New Collection
|
|
Dim nComponent&
|
|
Dim vNode As Variant
|
|
For Each vNode In iNodesOrder
|
|
nComponent = nodeComponents_(vNode)
|
|
Call SafeAddToCollection(nComponent, VBA.CStr(nComponent), iOrder)
|
|
Next vNode
|
|
Set SortComponents = iOrder
|
|
End Function
|
|
|
|
Private Function GroupNodesInduced(iNodes As Collection, iComponents As Collection) As Collection
|
|
Dim iResult As New Collection
|
|
Dim nComponent As Variant
|
|
For Each nComponent In iComponents
|
|
Dim vNode As Variant
|
|
For Each vNode In iNodes
|
|
If Not sourceOrder_.Exists(vNode) Then _
|
|
GoTo NEXT_NODE
|
|
If nodeComponents_(vNode) = nComponent Then _
|
|
Call iResult.Add(vNode)
|
|
NEXT_NODE:
|
|
Next vNode
|
|
Next nComponent
|
|
Set GroupNodesInduced = iResult
|
|
End Function
|
|
|