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
