[VB6] Map and Reduce

Following on from a previous posting about Fluent VB6 we look now at two routines which pop up a lot these days: Map and Reduce. On offer here is one way of implementing these two functional programming stalwarts. They are presented here as part of a FluentVB6 object, but could just as easily be declared and used separately.

I'm implementing these using the MSScript object which also appeared in the aforementioned posting. This makes available to the programmer, out of the box, the functionality of two scripting languages, VBScript and JScript. Other languages are available within the Windows Scripting Host environment and these could also be used (e.g. PerlScript as per the link.)

The code below tests the Map and Reduce functions. After this the implementation will be discussed.

Dim words As New Collection
    words.Add "cat"
    words.Add "dog"
    words.Add "cow"
    words.Add "wolf"
    words.Add "rat"
    
    Dim F As New FunctionalObject
    
    Dim upperwords As New Collection
    Set upperwords = F.WorkingWith(words).Map("UCase(Value)").AsCollection()
    
    Dim concatenated As Variant
    F.Reset
    concatenated = F.WorkingWith(upperwords).Reduce(vbNullString, "InitValue = InitValue & Value").asValue()
    
    Dim counted As Variant
    counted = F.Reset().WorkingWith(upperwords).Reduce(0, "initValue = initValue + Len(Value)").asValue()

For the sake of simplicity, I'm limiting things to Collections in, Collections and Variants out. The code could be readily changed to handle Arrays, Dictionaries and other data structures.

The class is called FunctionalObject and it begins with

Option Explicit

Private workingCollection As Collection
Private incomingCollection As Collection
Private workingValue As Variant
Private SC As ScriptControl

Private Sub Class_Initialize()
    Set workingCollection = New Collection
    Set incomingCollection = New Collection
    workingValue = vbEmpty
    Set SC = New ScriptControl
End Sub

No surprises there. Again, the ScriptControl object is the OCX added via the Project menu as a Reference rather than as a Component. One could late-bind with CreateObject but there's not much point in this case.

Next the public function to receive the incoming collection

Public Function WorkingWith(inCol As Collection) As FunctionalObject
    Set incomingCollection = inCol
    Set WorkingWith = Me
End Function

Reset clears the workingCollection (in the event that you reuse the currently instantiation of the FunctionalObject rather than instantiate another one.)

Public Function Reset() As FunctionalObject
    Dim i As Integer
    For i = 1 To workingCollection.Count
        workingCollection.Remove 1
    Next
    workingValue = vbEmpty
    Set Reset = Me
End Function

wrapText you'll seen before from the previous posting. It just makes the incoming collection's value palatable to VBScript.

Private Function wrapItem(v As Variant) As String
    If VarType(v) = vbString Then
        wrapItem = Chr$(34) & v & Chr$(34)
    Else
        wrapItem = CStr(v)
    End If
End Function

Next the Map function. The ScriptControl language is set to VBScript and the "safe subset" of script language functions is selected. Then the code iterates through each element of the incoming collection, and sets a VBScript place-holder variable called Value to that element. Next the map script is evaluated in the context of Value, the result being added to the working collection.

The example at the top of page has the map script as "UCase(Value)", so the value stored in the working collection is the uppercase of the value in the incoming collection.

Public Function Map(Optional script As String = "Value") As FunctionalObject
    SC.Language = "VBScript"
    SC.UseSafeSubset = True
    Dim i As Integer
    For i = 1 To incomingCollection.Count
        SC.ExecuteStatement "Value = " & wrapItem(incomingCollection.Item(i))
        workingCollection.Add SC.Eval(script)
    Next
    Set Map = Me
End Function

Reduce works in a similar manner except the result is a variant. There is the expectation that the reduce script will somehow work toward deriving a single value from the incoming collection, thus the use of an second place-holder called InitValue. The first parameter of the Reduce call is stored in InitValue with the expectation that the reduce script will refer to it and to the Value place-holder.

For example, one of the examples from the first code block reads, in part,

Reduce(0, "initValue = initValue + Len(Value)").

This reduces the collection to a value accruing the lengths of the strings assumed to be in the incoming collection.

Both parameters to Reduce are marked as optional. If neither is specified, the Reduce does nothing except set Value to InitValue, effectively filling the working collection with as many zeroes as there are items in the incoming collection.

Public Function Reduce(Optional initval As Variant = 0, Optional script As String = "Value = InitValue") As Variant
    SC.Language = "VBScript"
    SC.UseSafeSubset = True
    Dim vAnswer As Variant
    Dim vItem As Variant
    Dim vResult As Variant
    Dim i As Integer
    SC.ExecuteStatement "InitValue = " & wrapItem(initval)
    For i = 1 To incomingCollection.Count
        vItem = incomingCollection.Item(i)
        SC.ExecuteStatement "Value = " & wrapItem(vItem)
        SC.ExecuteStatement script
    Next
    workingValue = SC.Eval("InitValue")
    Set Reduce = Me
End Function

Finally the two output functions, asCollection and asValue. The former copies the working collection to an answer collection and returns that to the caller. asValue returns the working value from the Reduce.

Public Function AsCollection() As Collection
    Dim answerCollection As New Collection
    Dim i As Integer
    For i = 1 To workingCollection.Count
        answerCollection.Add workingCollection.Item(i)
    Next
    Set AsCollection = answerCollection
End Function

Public Function asValue() As Variant
    asValue = workingValue
End Function

I will make the sources available on Github in the near future.

© Copyright Bruce M. Axtens, 2015