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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
' 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.
|
1 2 3 4 5 6 |
Sub Recursive Process ME for each child child.recursive next child end sub |
|
1 2 3 4 5 6 7 8 |
Sub Recursive for each child child.recursive next child Process ME end sub |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
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 |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
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
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
' 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
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
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.