Assigning Parents and Children

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,  follow me on twitter, or follow me on g+
Comments