36
\$\begingroup\$

Context

I'm working on a little project that consists in a series of Microsoft Excel add-ins (.xlam). The code being submitted for review here, is located in the Reflection project:

project explorer tree, showing Logging, Reflection, System, and UnitTesting projects

Feel free to comment on the project architecture, but I'm mostly interested in the Reflection.LinqEnumerable class.


Linq?

Ok not exactly , but very much inspired by System.Linq.Enumerable, and only made possible with the Reflection.Delegate class. I'm working on a Grouping class that will enable adding a GroupBy method in there... but for now these are the members of the LinqEnumerable class:

members of LinqEnumerable

The Object Explorer displays a mini-documentation for the selected method because I've added hidden VB_Description attributes for every public method.

Here's the whole class, with the attributes:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "LinqEnumerable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private encapsulated As New Collection
Option Explicit

Private Function EquateReferenceTypes(value As Variant, other As Variant) As Boolean

    Dim equatable As IEquatable
    If TypeOf value Is IEquatable Then

        Set equatable = value
        EquateReferenceTypes = equatable.Equals(other)
    Else

        EquateReferenceTypes = (ObjPtr(value) = ObjPtr(other))
    End If

End Function

Private Function EquateValueTypes(value As Variant, other As Variant) As Boolean
    EquateValueTypes = (value = other)
End Function


Friend Sub Add(ParamArray values())

    Dim valuesArray() As Variant
    valuesArray = values

    AddArray valuesArray

End Sub

Friend Sub Concat(ByVal values As LinqEnumerable)
    AddArray values.ToArray
End Sub

Friend Sub AddArray(values() As Variant)

    Dim value As Variant, i As Long
    For i = LBound(values) To UBound(values)
        encapsulated.Add values(i)
    Next

End Sub


Public Property Get Item(ByVal index As Long) As Variant
Attribute Item.VB_Description = "Gets or sets the element at the specified index."
Attribute Item.VB_UserMemId = 0

    If IsObject(encapsulated(index)) Then
        Set Item = encapsulated(index)
    Else
        Item = encapsulated(index)
    End If

End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_Description = "Gets an enumerator that iterates through the sequence."
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = encapsulated.[_NewEnum]
End Property

Public Property Get Count() As Long
Attribute Count.VB_Description = "Gets the number of elements in the sequence."
    Count = encapsulated.Count
End Property

Public Function Contains(ByVal value As Variant) As Boolean
Attribute Contains.VB_Description = "Determines whether an element is in the sequence."
    Contains = (IndexOf(value) <> -1)
End Function

Public Function Distinct() As LinqEnumerable
Attribute Distinct.VB_Description = "Returns distinct elements from the sequence."

    Dim result As New LinqEnumerable

    Dim value As Variant
    For Each value In encapsulated
        If Not result.Contains(value) Then result.Add value
    Next

    Set Distinct = result

End Function

Public Function Except(ByVal values As LinqEnumerable) As LinqEnumerable
Attribute Except.VB_Description = "Produces the set difference with specified sequence."

    Dim result As New LinqEnumerable

    Dim value As Variant
    For Each value In encapsulated
        If Not values.Contains(value) Then result.Add value
    Next

    Set Except = result

End Function

Public Function First() As Variant
Attribute First.VB_Description = "Returns the first element in the sequence."

    If Count = 0 Then Exit Function

    If IsObject(Item(1)) Then
        Set First = Item(1)
    Else
        First = Item(1)
    End If

End Function

Public Function FromArray(ByRef values() As Variant) As LinqEnumerable
Attribute FromArray.VB_Description = "Creates a new instance by copying elements of an array."

    Dim result As New LinqEnumerable
    result.AddArray values

    Set FromArray = result

End Function

Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."

    Dim result As New LinqEnumerable

    Dim value As Variant
    For Each value In values
        result.Add value
    Next

    Set FromCollection = result

End Function

Public Function FromEnumerable(ByVal value As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."

    Dim result As LinqEnumerable
    Set result = LinqEnumerable.FromArray(value.ToArray)

    Set FromEnumerable = result

End Function

Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."

    Dim result As New LinqEnumerable

    Dim value As Variant
    For Each value In values
        result.Add value
    Next

    Set FromList = result

End Function

Public Function GetRange(ByVal index As Long, ByVal valuesCount As Long) As LinqEnumerable
Attribute GetRange.VB_Description = "Creates a copy of a range of elements."

    Dim result As LinqEnumerable
    If index > Count Then Err.Raise 9

    Dim lastIndex As Long
    lastIndex = IIf(index + valuesCount > Count, Count, index + valuesCount)

    Set result = New LinqEnumerable

    Dim i As Long
    For i = index To lastIndex
        result.Add Item(i)
    Next

    Set GetRange = result

End Function

Public Function IndexOf(value As Variant) As Long
Attribute IndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the first occurrence within the sequence."

    Dim found As Boolean
    Dim isRef As Boolean

    If Count = 0 Then IndexOf = -1: Exit Function

    Dim i As Long
    For i = 1 To Count

        If IsObject(Item(i)) Then

            found = EquateReferenceTypes(value, Item(i))
        Else

            found = EquateValueTypes(value, Item(i))
        End If

        If found Then IndexOf = i: Exit Function

    Next

    IndexOf = -1

End Function

Public Function Last() As Variant
Attribute Last.VB_Description = "Returns the last element of the sequence."

    If Count = 0 Then Exit Function

    If IsObject(Item(Count)) Then
        Set Last = Item(Count)
    Else
        Last = Item(Count)
    End If

End Function

Public Function LastIndexOf(value As Variant) As Long
Attribute LastIndexOf.VB_Description = "Searches for the specified object and returns the 1-based index of the last occurrence within the sequence."

    Dim found As Boolean
    Dim isRef As Boolean

    LastIndexOf = -1
    If Count = 0 Then Exit Function

    Dim i As Long
    For i = 1 To Count

        If IsObject(Item(i)) Then

            found = EquateReferenceTypes(value, Item(i))
        Else

            found = EquateValueTypes(value, Item(i))
        End If

        If found Then LastIndexOf = i

    Next

End Function

Public Function ToArray() As Variant()
Attribute ToArray.VB_Description = "Copies the entire sequence into an array."

    Dim result() As Variant
    ReDim result(1 To Count)

    Dim i As Long
    If Count = 0 Then Exit Function

    For i = 1 To Count
        If IsObject(Item(i)) Then
            Set result(i) = Item(i)
        Else
            result(i) = Item(i)
        End If
    Next

    ToArray = result

End Function

Public Function ToDictionary(ByVal keySelector As Delegate, Optional ByVal valueSelector As Delegate = Nothing) As Scripting.Dictionary
Attribute ToDictionary.VB_Description = "Creates a System.Dictionary according to specified key selector and element selector functions."

    Dim result As New Scripting.Dictionary

    Dim value As Variant
    For Each value In encapsulated

        If valueSelector Is Nothing Then
            result.Add keySelector.Execute(value), value
        Else
            result.Add keySelector.Execute(value), valueSelector.Execute(value)
        End If
    Next

    Set ToDictionary = result

End Function

Public Function ToCollection() As VBA.Collection
Attribute ToCollection.VB_Description = "Copies the entire sequence into a new VBA.Collection."

    Dim result As New VBA.Collection

    Dim value As Variant
    For Each value In encapsulated
        result.Add value
    Next

    Set ToCollection = result

End Function

Public Function ToList() As System.List
Attribute ToList.VB_Description = "Copies the entire sequence into a new System.List."

    Dim result As System.List
    Set result = List.Create
    result.AddArray Me.ToArray

    Set ToList = result

End Function

Public Function OfTypeName(ByVal value As String) As LinqEnumerable
Attribute OfTypeName.VB_Description = "Filters elements based on a specified type."

    Dim result As LinqEnumerable

    Dim element As Variant
    For Each element In encapsulated
        If TypeName(element) = value Then result.Add element
    Next

    Set OfTypeName = result

End Function

Public Function SelectValues(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectValues.VB_Description = "Projects each element of the sequence."

    Dim result As New LinqEnumerable

    Dim element As Variant
    For Each element In encapsulated
        result.Add selector.Execute(element)
    Next

    Set SelectValues = result

End Function

Public Function SelectMany(ByVal selector As Delegate) As LinqEnumerable
Attribute SelectMany.VB_Description = "Projects each element into a sequence of elements, and flattens the resulting sequences into one sequence."

    Dim result As New LinqEnumerable

    Dim element As Variant
    For Each element In encapsulated

        'verbose, but works with anything that supports a For Each loop

        Dim subList As Variant
        Set subList = selector.Execute(element)

        Dim subElement As Variant
        For Each subElement In subList
            result.Add subElement
        Next

    Next

    Set SelectMany = result

End Function

Public Function Aggregate(ByVal accumulator As Delegate) As Variant
Attribute Aggregate.VB_Description = "Applies an accumulator function over a sequence."

    Dim result As Variant

    Dim isFirst As Boolean

    Dim value As Variant
    For Each value In encapsulated
        If isFirst Then
            result = value
            isFirst = False
        Else
            result = accumulator.Execute(result, value)
        End If
    Next

    Aggregate = result

End Function

Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
Attribute Where.VB_Description = "Filters the sequence based on a predicate."

    Dim result As New LinqEnumerable

    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then result.Add element
    Next

    Set Where = result

End Function

Public Function FirstWhere(ByVal predicate As Delegate) As Variant
Attribute FirstWhere.VB_Description = "Returns the first element of the sequence that satisfies a specified condition."

    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then
            If IsObject(element) Then
                Set FirstWhere = element
            Else
                FirstWhere = element
            End If
            Exit Function
        End If
    Next

End Function

Public Function LastWhere(ByVal predicate As Delegate) As Variant
Attribute LastWhere.VB_Description = "Returns the last element of the sequence that satisfies a specified condition.."

    Dim result As Variant
    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then
            If IsObject(element) Then
                Set result = element
            Else
                result = element
            End If
        End If
    Next

    If IsObject(result) Then
        Set LastWhere = result
    Else
        LastWhere = result
    End If

End Function

Public Function CountIf(ByVal predicate As Delegate) As Long
Attribute CountIf.VB_Description = "Returns a number that represents how many elements in the specified sequence satisfy a condition."

    Dim result As Long

    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then result = result + 1
    Next

    CountIf = result

End Function

Public Function AllItems(ByVal predicate As Delegate) As Boolean
Attribute AllItems.VB_Description = "Determines whether all elements of the sequence satisfy a condition."

    Dim element As Variant
    For Each element In encapsulated
        If Not predicate.Execute(element) Then
            Exit Function
        End If
    Next

    AllItems = True

End Function

Public Function AnyItem(ByVal predicate As Delegate) As Boolean
Attribute AnyItem.VB_Description = "Determines whether any element of the sequence satisfy a condition."

    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then
            AnyItem = True
            Exit Function
        End If
    Next

End Function

Note that due to language constraints I had to make some compromises:

  • The overload of First taking a predicate parameter was renamed to FirstWhere; same with the Last overload, renamed to LastWhere - that's because VBA doesn't support overloading, obviously.
  • Select was renamed to SelectValues, because "Select" is a reserved keyword.
  • OfType was renamed to the here-more-accurate OfTypeName, since the function is really comparing type names; type comparison is possible in VBA, but not with value types - it's simpler to just take a type name and verify that instead.

So, is this LINQ - Language-INtegrated Query for VBA? Not sure... but this is definitely a number of steps away from the plain old vanilla Collection class.


Example

Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")

Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
                          .Aggregate(accumulator)

Produces this output:

fox brown quick the
\$\endgroup\$
  • \$\begingroup\$ IMO: LINQ is definitely not possible with VBA no matter how hard you try because besides the class members that's a whole new world of syntax and features that you can't imitate in VBA - one of the reasons LINQ is not just a class library... or maybe I am just incompetent...:) \$\endgroup\$ – user28366 Oct 15 '14 at 7:15
  • 1
    \$\begingroup\$ I think all that's stopping me is that there are no extension methods in VBA. But they are just syntax sugar for static method calls. The LINQ query syntax gets compiled to method calls... ok no IQueryable in VBA... but the real showstopper is deferred execution / lazy evaluation. And the notion of a query provider, so LINQ to Entities can spit out T-SQL. I'm not talking about implementing all of LINQ in VBA... ...but with a Delegate class, most of System.Linq.Enumerable can be implemented now. Enumerable.Where in VBA was impossible for me, just 2 days ago. \$\endgroup\$ – Mathieu Guindon Oct 15 '14 at 11:32
  • \$\begingroup\$ LINQ is a spec so you should be able to implement it in any language that has collections and function pointers. Though you may be unable to implement laziness. \$\endgroup\$ – Raz Megrelidze Oct 15 '14 at 13:23
  • 1
    \$\begingroup\$ @RezoMegrelidze you somehow can pass functions as parameters if you metadata things. For example by functions name to Application.Run or the UDF hack \$\endgroup\$ – user28366 Oct 15 '14 at 14:05
  • 1
    \$\begingroup\$ Whoever makes this code work with AddressOf will get an additional over-the-top bounty. \$\endgroup\$ – Mathieu Guindon Dec 24 '14 at 18:30
13
+50
\$\begingroup\$

Decomposition

There are redundancies in translating from Array and Collection.

Consider these three snippits

Dim value As Variant, i As Long 'value is unused?
For i = LBound(values) To UBound(values)
    encapsulated.Add values(i)
Next

Dim value As Variant
For Each value In values
    result.Add value
Next

Set result = LinqEnumerable.FromArray(value.ToArray)

They all do the same thing. Why translate from LinqEnumerable to Array just to go back to LinqEnumerable? Why have a separate method for adding an Array or Enumerable when the same procedure works for both?

Private Sub Extend(ByVal sequence As Variant)
    Dim element As Variant
    For Each element in sequence
        encapsulated.Add element
    Next element
End Sub
Friend Sub Add(ParamArray values() As Variant)
    Extend values
End Sub
Friend Sub Concat(ByVal values As LinqEnumerable)
    Extend values
End Sub
Friend Sub AddArray(values() As Variant)
    Extend values
End Sub
' Optional New methods
Friend Sub AddCollection(ByVal values As VBA.Collection)
    Extend values
End Sub
Friend Sub AddList(ByVal values As System.List)
    Extend values
End Sub

All of those methods did the same thing, but expected different inputs. Duck-typing is one of the few high-level features that VBA does right. It's a shame to not take advantage of it.

Public Function FromCollection(ByVal values As VBA.Collection) As LinqEnumerable
Attribute FromCollection.VB_Description = "Creates a new instance by copying elements of a VBA.Collection instance."

    Dim result As New LinqEnumerable
    result.AddCollection values
    Set FromCollection = result

End Function

Public Function FromEnumerable(ByVal values As System.Enumerable) As LinqEnumerable
Attribute FromEnumerable.VB_Description = "Creates a new instance by copying elements of a System.Enumerable instance."

    Dim result As LinqEnumerable
    result.Concat values
    Set FromEnumerable = result

End Function
Public Function FromList(ByVal values As System.List) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."

    Dim result As New LinqEnumerable
    result.AddList values
    Set FromList = result

End Function
Public Function FromArray(ByVal values() As Variant) As LinqEnumerable
Attribute FromList.VB_Description = "Creates a new instance by copying elements of a System.List instance."

    Dim result As New LinqEnumerable
    result.AddArray values
    Set FromList = result

End Function

You can keep them if you want to enforce type safety, but I wouldn't. You need to add a two new methods for every other container you want to support. Honestly, I would just dump all but Extend and Add and make Extend Friend, then create just these two methods.

Friend Sub Extend(ByVal sequence As Variant)
    Dim element As Variant
    For Each element in sequence
        encapsulated.Add element
    Next element
End Sub
Friend Sub Add(ParamArray values() As Variant)
    Extend values
End Sub
Public Function Create(ParamArray values() As Variant) As LinqEnumerable
    Set Create = CreateFrom(values)
End Function
Public Function CreateFrom(ByVal values As Variant) As LinqEnumerable
    Dim result As New LinqEnumerable
    result.Extend values
    Set CreateFrom = result
End Function
\$\endgroup\$
11
\$\begingroup\$

You can fake overloading and doing so will make for a friendlier API. First, make FirstWhere and LastWhere private. Then add an optional argument to First and Last. Simply check to see if predicate Is Nothing, if it is, call the appropriate private method, else run the code that returns First/Last.

Public Function First(Optional ByVal predicate As Delegate) As Variant
Attribute First.VB_Description = "Returns the first element in the sequence. If passed a predicate, returns the first element that matches the criteria."

    If Not predicate Is Nothing Then 
        First = FirstWhere(predicate)
        Exit Function
    End If

    If Count = 0 Then Exit Function

    If IsObject(Item(1)) Then
        Set First = Item(1)
    Else
        First = Item(1)
    End If

End Function
\$\endgroup\$
  • \$\begingroup\$ I'll try to come back and give it a more thorough review later. \$\endgroup\$ – RubberDuck Oct 15 '14 at 11:49
  • \$\begingroup\$ Have you forgot about this? there could be a bounty in it for you.... \$\endgroup\$ – Malachi Dec 31 '14 at 15:15

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.