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
FunctionalObjectand 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 SubNo 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
CreateObjectbut 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
Resetclears the workingCollection (in the event that you reuse the currently instantiation of the
FunctionalObjectrather 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
wrapTextyou'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 FunctionNext the
Mapfunction. 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
Valueto 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 FunctionReduce 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
Reducecall is stored in
InitValuewith the expectation that the reduce script will refer to it and to the
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 FunctionFinally the two output functions,
asValue. The former copies the working collection to an answer collection and returns that to the caller.
asValuereturns the working value from the
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 FunctionI will make the sources available on Github in the near future.
© Copyright Bruce M. Axtens, 2015