Recap
In the introduction to the Roadmapping project we created a rudimentary procedure and class that read in our data and created the basic structure we will need to produce generalized road-maps from simple tabular data.
The next step is actually the key activity, and the reason why recursion is a necessary technique for this project.
Assigning parents to each data row
Each data row has as ID and Target as below
We need to create this structure from it.
For example Vespa is the parent of both Skates and Bike, and is the child of Harley. So far we have assigned all items to be children of Frame. Our class cShapeContainer has now been enhanced to allow this capability, and our Roadmapper program has been updated to make it happen. Replace your current code with the code at the bottom of the page and lets see how this works.
Within our dotheMap procedure, once the data is read in – we have to execute a new method to ‘rearrange our data items from the current flat structure, to a hierarchical one.
‘ sort out the parent/child relationships
scRoot.SpringClean
That is split into 2 parts – first find all the the items who have the current item as their target and make the link, then break the link with the frame.
' one off reassociation of items from the root to be children of their target
' no need for recursion since to start with all are associated with the top level frame
Private Sub Associate()
Debug.Assert pscType = sctFrame
Dim scParent As cShapeContainer, scChild As cShapeContainer, n As Long
For Each scParent In pChildren
' who has me as their target?
For Each scChild In pChildren
If scChild.Target = scParent.ID Then
scParent.Children.Add scChild, scChild.ID
' confirm the parent as found
Set scChild.Parent = scParent
End If
Next scChild
Next scParent
' now all we need to do is clean up the children of the frame
n = pChildren.Count
While n > 0
Set scChild = pChildren(n)
If Not scChild.Valid Then
' we get here because we didnt find a target yet
If scChild.Target <> ID Then
' and it wasnt the frame.. so
MsgBox ("Did not find target " & scChild.Target & " for ID " & scChild.ID)
End If
' confirm the frame as the parent
Set scChild.Parent = Me
Else
' remove from the frames children as already now child of someone else
pChildren.Remove (n)
End If
' belt and braces
Debug.Assert scChild.Valid
n = n - 1
Wend
End Sub
Recursion beginnings
Here we are seeing the first recursion execution. Our debug report needs to call itself since the data structure now has an unknown depth of parent/child relationships. This is typical structure of a recursive procedure. Think of it like this – First deal with me, then call myself for each of my children.
Sub Recursive Process ME for each child child.recursive next child end sub
Sometimes you need to do it the other way round – deal with the children first – thats very easy, just reverse the order . It really is that simple.
Sub Recursive for each child child.recursive next child Process ME end sub
Here is our debug report that will now recurse since we have organized our data
Public Sub debugReport() Dim sc As cShapeContainer If pChildren.Count = 0 Then Debug.Print "--Nochildren:" & ID & ":Target:" & Target Else Debug.Print "Parent:" & ID & ": has " & CStr(pChildren.Count) & " children" For Each sc In pChildren Debug.Print "--:report on child:" & sc.ID & " of " & ID sc.debugReport Next sc End If End Sub
…and here is the output – see if you can relate the order it comes out in to the Deal with me, then my children recursion order.
Parent:_frame_: has 1 children --:report on child:plan of _frame_ Parent:plan: has 1 children --:report on child:4x4 of plan Parent:4x4: has 2 children --:report on child:smart of 4x4 Parent:smart: has 1 children --:report on child:harley of smart Parent:harley: has 2 children --:report on child:vespa of harley Parent:vespa: has 2 children --:report on child:skates of vespa --Nochildren:skates:Target:vespa --:report on child:bike of vespa --Nochildren:bike:Target:vespa --:report on child:buybike of harley --Nochildren:buybike:Target:harley --:report on child:ram of 4x4 Parent:ram: has 1 children --:report on child:barrow of ram --Nochildren:barrow:Target:ram
Next steps
Next we are going to start plotting and creating shapes. But before we can do that we need to be able to calculate things like the height of the shape, which will be dependent on how many children an item has, and how many grandchildren etc. etc. However before even we can do that, one of the key things we are going to need is a way to provide parameter information such as colors, size and so on. Luckily, the cDataSet set of classes has a very straightforward capability for collecting parameters, so read on and we’ll see how to get parameter values into our program.
Version 2: Full updated code – replace your current project with this code
cShapeContainer – Version 2
' cShapeContainer Class
Option Explicit
Public Enum scTypeS
sctData
sctFrame
End Enum
Const FrameID = "_frame_"
Private pscType As scTypeS
Private pShape As Shape
Private pDataRow As cDataRow
Private pChildren As Collection
Private pRoot As cShapeContainer
Private pParent As cShapeContainer
Public Property Get scType() As scTypeS
scType = pscType
End Property
Public Property Get Shape() As Shape
Set Shape = pShape
End Property
Public Property Get root() As cShapeContainer
Set root = pRoot
End Property
Public Property Set Shape(p As Shape)
Set pShape = p
End Property
Public Property Get Children() As Collection
Set Children = pChildren
End Property
Public Property Get Parent() As cShapeContainer
Set Parent = pParent
End Property
Public Property Set Parent(p As cShapeContainer)
Set pParent = p
End Property
Public Property Get ID() As String
ID = fetchKey("ID")
End Property
' if parent is confirmed use the parents ID, otherwise go to the data. If blank, use the frame as the target
Public Property Get Target() As String
Dim s As String
If Valid Then
s = pParent.ID
Else
s = fetchKey("Target")
If s = vbNullString Then
s = pRoot.ID
End If
End If
Target = s
End Property
' pick up the text from the data, or provide a default value for the frame
Public Property Get Text() As String
If pDataRow Is Nothing Then
Debug.Assert pscType = sctFrame
Text = "Roadmap Frame"
Else
Debug.Assert pscType = sctData
Text = pDataRow.toString("Description")
End If
End Property
' doesnt become valid until a parent is confirmed
Public Property Get Valid() As Boolean
Valid = (Not pParent Is Nothing)
End Property
' goto the data, or use a default value if the frame
Private Function fetchKey(s As String) As String
If pDataRow Is Nothing Then
Debug.Assert pscType = sctFrame
fetchKey = FrameID
Else
Debug.Assert pscType = sctData
fetchKey = makeKey(pDataRow.toString(s))
End If
End Function
' call to set to initial values
Public Function create(rt As cShapeContainer, Optional pr As cDataRow = Nothing)
If pr Is Nothing Then
pscType = sctFrame
Else
pscType = sctData
End If
Set pDataRow = pr
Set pRoot = rt
Set pChildren = New Collection
End Function
' call after all data is loaded to make parent.children associations
Public Sub SpringClean()
Debug.Assert pscType = sctFrame
Associate
End Sub
' check if this ChildExists in current children
Public Function ChildExists(v As Variant) As cShapeContainer
On Error GoTo handle
Set ChildExists = pChildren(makeKey(v))
Exit Function
handle:
Set ChildExists = Nothing
End Function
' standardize way of treating string items as keys to avoid case problems
Private Function makeKey(v As Variant) As String
makeKey = LCase(Trim(CStr(v)))
End Function
' Find object by ID
Public Function Find(vId As Variant) As cShapeContainer
Dim sc As cShapeContainer, scFound As cShapeContainer
Set scFound = ChildExists(vId)
' it wasnt in my children .. see if its in my childrens children etc
If scFound Is Nothing Then
For Each sc In pChildren
Set scFound = sc.Find(vId)
If Not scFound Is Nothing Then
Exit For
End If
Next sc
End If
Set Find = scFound
End Function
' one off reassociation of items from the root to be children of their target
' no need for recursion since to start with all are associated with the top level frame
Private Sub Associate()
Debug.Assert pscType = sctFrame
Dim scParent As cShapeContainer, scChild As cShapeContainer, n As Long
For Each scParent In pChildren
' who has me as their target?
For Each scChild In pChildren
If scChild.Target = scParent.ID Then
scParent.Children.Add scChild, scChild.ID
' confirm the parent as found
Set scChild.Parent = scParent
End If
Next scChild
Next scParent
' now all we need to do is clean up the children of the frame
n = pChildren.Count
While n > 0
Set scChild = pChildren(n)
If Not scChild.Valid Then
' we get here because we didnt find a target yet
If scChild.Target <> ID Then
' and it wasnt the frame.. so
MsgBox ("Did not find target " & scChild.Target & " for ID " & scChild.ID)
End If
' confirm the frame as the parent
Set scChild.Parent = Me
Else
' remove from the frames children as already now child of someone else
pChildren.Remove (n)
End If
' belt and braces
Debug.Assert scChild.Valid
n = n - 1
Wend
End Sub
Public Sub debugReport()
Dim sc As cShapeContainer
If pChildren.Count = 0 Then
Debug.Print "--Nochildren:" & ID & ":Target:" & Target
Else
Debug.Print "Parent:" & ID & ": has " & CStr(pChildren.Count) & " children"
For Each sc In pChildren
Debug.Print "--:report on child:" & sc.ID & " of " & ID
sc.debugReport
Next sc
End If
End Sub
Roadmapper Module – Version 2
Option Explicit
Public Sub RoadMapper()
Dim dSet As cDataSet
Set dSet = New cDataSet
' just need to provide the range where data headings are
With dSet
.populateData Range("InputData!$a$1:$e$1")
If .Where Is Nothing Then
MsgBox ("No data to process")
Else
' check we have fields we need
If .HeadingRow.Validate(True, "Activate", "Deactivate", "ID", "Target", "Description") Then
Call doTheMap(dSet)
End If
End If
End With
End Sub
Private Sub doTheMap(ByRef dSet As cDataSet)
Dim scRoot As cShapeContainer, sc As cShapeContainer, dr As cDataRow
' this will be the root - the frame
Set scRoot = New cShapeContainer
scRoot.create scRoot
' create for each datarow
For Each dr In dSet.Rows
Set sc = scRoot.Find(dr.toString("ID"))
If sc Is Nothing Then
Set sc = New cShapeContainer
sc.create scRoot, dr
scRoot.Children.Add sc, sc.ID
Else
MsgBox sc.ID & " is a duplicate - skipping"
End If
Next dr
' sort out the parent/child relationships
scRoot.SpringClean
'debug to see what that all looks like
scRoot.debugReport
End Sub
For help and more information join our community, follow the blog or follow me on twitter.