# Coding Decision Trees in VBA

I have created a function in VBA as follows:

Private Enum gridInstruction    'in the class declarations section
Place_Break 'not enumerated to anything specific, so uses default 0,1,2...
Place_Chain
Place_Chain_Flag
Skip
End Enum

Private Function applyRules(ByVal imgGrid As Collection) As gridInstruction 'applies rules to imggrid based on input values
Dim step1 As Boolean
Dim step2 As Byte
Dim step3 As Byte
step1 = (imgGrid("B2").Left = 0)
If firstCol Then
step2 = bestChain("b2", imgGrid)
Select Case step2
Case 1
applyRules = Place_Chain
Case 2
step3 = chainedBy("C2", imgGrid)
Select Case step3
Case 1
applyRules = Skip
Case 2
applyRules = Place_Chain
Case 3
applyRules = Place_Chain
End Select
Case 3
step3 = chainedBy("C3", imgGrid)
Select Case step3
Case 1
applyRules = Skip
Case 2
applyRules = Skip
Case 3
applyRules = Place_Chain
End Select
End Select
Else
step2 = chainedBy("b2", imgGrid)
Select Case step2
Case 1
applyRules = Place_Break
Case 2
step3 = bestChain("A2", imgGrid)
Select Case step3
Case 1
applyRules = Place_Break
Case 2
applyRules = Place_Chain
Case 3
applyRules = Place_Chain_Flag    'set chain flag to come back here when chain next breaks
End Select
Case 3
step3 = bestChain("A3", imgGrid)
Select Case step3
Case 1
applyRules = Skip
Case 2
applyRules = Skip
Case 3
applyRules = Place_Chain
End Select
End Select
End If
End Function


Private Function bestChain(imgAddress As String, gridVals As Collection) As Byte


And

Private Function chainedBy(imgAddress As String, gridVals As Collection) As Byte


which return an integer 1-3, stored as a Byte (almost certainly premature optimisation, but I don't find it any less readable than say Integer or Long)

This function can be summarised with a tree structure like this:

In case it's not clear: Green Ovals are tests, Blue Arrows are the results from those tests, Orange Boxes are the return values of the function. None of the tests are identical so I don't think there's any other way of structuring that decision tree (correct me if I'm wrong)

But when I try to put this in code, it ends up messy; I worry that all of the Select Cases and If statements are going to be hard to read and maintain.

Is there a better way of structuring this code (and anything else worth highlighting)? NB. this function is called many times so I'm hoping to keep it as streamlined as possible - so any solutions which require many more variables to be assigned might be detrimental to the running time.

The 2 additional functions referenced here are:

Private Function bestChain(imgAddress As String, gridVals As Collection) As Byte
Dim toparray(1 To 3) As Long
Dim imgX As Long                             'column number
Dim imgY As Long                             'rownum
Dim imgIndex As Long
Dim nTop As Long, nMid As Long, nBot As Long, testImg As Long 'values of the tops of all images
Dim nTop_img As clsImg

imgX = Range(imgAddress).Column              'use range notation so address can be accessed with worksheet functions
imgIndex = (imgY - 1) * 3 + imgX             '3 * (rownum-1) + column

Set nTop_img = gridVals(imgIndex - 2)        ' -1 row +1 col
testImg = gridVals(imgIndex).Top
nMid = gridVals(imgIndex + 1).Top            ' +1 col
nBot = gridVals(imgIndex + 4).Top            ' +1 row +1 col
If nTop_img Is Nothing Then
toparray(1) = -1                         'flag as invalid
Else
toparray(1) = Abs(testImg - nTop_img.Top)
End If
toparray(2) = Abs(testImg - nMid)            ' abs distance in y between tops
toparray(3) = Abs(testImg - nBot)
bestChain = posArrMin(toparray)(1)           'index of best match
End Function


And

Private Function chainedBy(imgAddress As String, gridVals As Collection) As Byte
Dim toparray(1 To 3) As Long
Dim imgX As Long                             'column number
Dim imgY As Long                             'rownum
Dim imgIndex As Long
Dim pMid As Long, pBot As Long, testImg As Long 'values of the tops of all images in prev column
Dim pTop_img As clsImg

imgX = Range(imgAddress).Column              'use range notation so address can be accessed with worksheet functions
imgIndex = (imgY - 1) * 3 + imgX             '3 * (rownum-1) + column

Set pTop_img = gridVals(imgIndex - 4)        '-1 row - 1 col
testImg = gridVals(imgIndex).Top
pMid = gridVals(imgIndex - 1).Top            ' -1 col
pBot = gridVals(imgIndex + 2).Top            ' +1 row -1 col
If pTop_img Is Nothing Then
toparray(1) = -1                         'flag as invalid
Else
toparray(1) = Abs(testImg - pTop_img.Top)
End If
toparray(2) = Abs(testImg - pMid)            ' abs distance in y between tops
toparray(3) = Abs(testImg - pBot)
chainedBy = posArrMin(toparray)(1)           'index of best match
End Function


Which is the same as BestChain except that it references some slightly different elements of the collection.

The collection (and both functions assume this) is always 9 items in size, which represent a 3x3 grid, where each item in the collection has an [A1] style key. I.e. item 3 has the key "C1", item 8 is "B3". Each item is of clsImage type, a custom class I have declared, but for the purposes of this code can be treated as:

Type clsImg
Top As Long
Left As Long
Width As Long
Height As Long
End Type


The values in the top row (collection items 1-3) may be Nothing.

Finally, those 2 functions both reference a third function:

Private Function posArrMin(arr() As Long) As Long() 'function to return min value of positive array and its index
'-ve values skipped
'assumes at least 1 non negative value
Dim minVal As Long                           'minimum value in array
Dim thisVal As Long                          'value to be checked
Dim i As Long                                'iterator
Dim minI As Long                             'index of smallest value
Dim Results(1 To 2) As Long
minVal = -1
For i = LBound(arr) To UBound(arr)
thisVal = arr(i)
If thisVal >= 0 Then                     'otherwise skip
If thisVal < minVal Or minVal = -1 Then 'new min or min needs to be set
minVal = thisVal
minI = i
End If
End If
Next i
Results(1) = minI
Results(2) = minVal
posArrMin = Results                          'index, value
End Function


Which returns a slightly unusual Long(1 To 2) array - and only the first item is ever used in the bestChain and chainedBy function, but that's because this posArrMin function is reused elsewhere in my code

• Would be nice/beneficial to include the code for these two referenced functions, too. – Mathieu Guindon Aug 17 '17 at 11:14
• @Mat'sMug sorry for the delay, I've put them up now, as well as a function they both reference. Obviously I could add more detail with the routine which calls applyRules, but I think that would be getting out of the scope of the question. – Greedo Aug 17 '17 at 12:22
• To answer your question about improving the code to be more maintainable, I would recommend getting better with classes. IMO, none of this should be done with functions. It should all be class methods, functions, properties, etc. It may be a bit above your level of ability, but if you really want to improve the code (especially if you actually need this frequently) you should be using a class for the process. If done right, you could build a dynamic decision tree just by specifying how many classes to create (and parents, children, nodes, etc). – Brandon Barney Aug 22 '17 at 14:49
• To elaborate a little further, from what I can tell by your chart, your code boils down to Input, Test Group n, Test Conditions (n(x,y), n+1(x, y), n+2...). Then, the real method behind the madness is the TestDriver who likely needs a TestWriter, and a ResultRetriever. A structure like this should allow you to create the driver with the inputs, and let it do the work dynamically. – Brandon Barney Aug 22 '17 at 14:54
• Do you have an example of what collection would be passed to applyRules? – Raystafarian Mar 4 '18 at 5:52

I see how you struggle with your SELECT CASE in ApplyRules. It took some charting, but I think this is optimized

Private Function applyRules(ByVal imgGrid As Collection) As gridInstruction
Dim step1 As Boolean
Dim step2 As Byte
Dim step3 As Byte
step1 = (imgGrid("B2").Left = 0)

If firstcol Then
step2 = bestChain("b2", imgGrid)
Else
step2 = chainedBy("b2", imgGrid)
End If

Select Case Str(firstcol & step2)
Case "11"
applyRules = Place_Chain
Case "12", "13"
step3 = chainedBy("C" & step2, imgGrid)
Case "01"
applyRules = Place_Break
Case "02", "03"
step3 = bestChain("A" & step2, imgGrid)
End Select

If Not step2 = 1 Then
Select Case step2 & step3
Case 22, 33
applyRules = Place_Chain
Case 31, 32
applyRules = Skip
Case 21
If firstcol Then Skip
Else: applyRules = Place_Break
End If
Case 23
If firstcol Then
applyRules = Place_Chain
Else: applyRules = Place_Chain_Flag
End If
End Select
End If
End Function


Obviously you'll need to qualify some of those if they are range references.