40
\$\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
asked Oct 15, 2014 at 4:51
\$\endgroup\$
8
  • \$\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\$ Commented Oct 15, 2014 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\$ Commented Oct 15, 2014 at 11:32
  • 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\$ Commented Oct 15, 2014 at 14:05
  • 1
    \$\begingroup\$ It's not strictly true that VBA doesn't have function pointers. They're just not well supported. AddressOf returns a signed 4 byte integer value that represents the address of the specified proc, but I'm not sure that you want to go down that rabbit hole. \$\endgroup\$ Commented Dec 24, 2014 at 18:15
  • 1
    \$\begingroup\$ Whoever makes this code work with AddressOf will get an additional over-the-top bounty. \$\endgroup\$ Commented Dec 24, 2014 at 18:30

2 Answers 2

15
+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
answered Oct 15, 2014 at 16:11
\$\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
answered Oct 15, 2014 at 11:49
\$\endgroup\$
2
  • \$\begingroup\$ I'll try to come back and give it a more thorough review later. \$\endgroup\$ Commented Oct 15, 2014 at 11:49
  • \$\begingroup\$ Have you forgot about this? there could be a bounty in it for you.... \$\endgroup\$ Commented Dec 31, 2014 at 15:15

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.