Подождите, это? LINQ?

Контекст

Я работаю над небольшим проектом, который состоит из серии надстроек Microsoft Excel (.xlam). Код, представленный для ознакомления здесь, находится в проекте Reflection:

дерево проводника проекта, показывающее проекты ведения журнала, отражения, системы и юнита

Не забудьте прокомментировать архитектуру проекта, но меня больше всего интересует класс Reflection.LinqEnumerable.


Linq?

Ok не точно , но очень вдохновлен System.Linq.Enumerable , и это стало возможным только с помощью класса Reflection.Delegate . Я работаю над классом Grouping, который позволит добавить метод GroupBy там ... но на данный момент это члены LinqEnumerable класс:

члены LinqEnumerable

Проводник объектов отображает мини-документацию для выбранного метода, потому что я добавил скрытые атрибуты VB_Description для каждого общедоступного метода.

Вот весь класс с атрибутами:

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

Обратите внимание, что из-за языковых ограничений мне пришлось сделать некоторые компромиссы:

  • Перегрузка First с использованием предикатного параметра была переименована в FirstWhere; то же самое с перегрузкой Last, переименованной в LastWhere), потому что VBA не поддерживает перегрузку, очевидно.
  • Select было переименовано в SelectValues, потому что «Выбрать» - зарезервированное ключевое слово.
  • OfType был переименован в более точное OfTypeName, поскольку функция действительно сравнивает имена типов; тип сравнения возможен в VBA, но не со значениями типов - проще просто взять имя типа и убедиться, что вместо этого.

Итак, это LINQ - Language-INtegrated Query для VBA? Не уверен ... но это определенно в нескольких шагах от простого старого класса ванили Collection.


Пример

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

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

Производит этот вывод:

 fox brown quick the
35 голосов | спросил Mathieu Guindon 15 +04002014-10-15T08:51:01+04:00312014bEurope/MoscowWed, 15 Oct 2014 08:51:01 +0400 2014, 08:51:01

2 ответа


12

Распад

Есть избыточность в переводе из Array и Collection.

Рассмотрим эти три фрагмента

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)

Все они делают то же самое. Зачем переводить из LinqEnumerable в Array только для возврата к LinqEnumerable? Почему у вас есть отдельный метод добавления Array или Enumerable, когда одна и та же процедура работает для обоих?

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

Все эти методы сделали то же самое, но ожидали разные входы. Duck-typing - одна из немногих функций высокого уровня, которые VBA делает правильно. Это позор, чтобы не воспользоваться этим.

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

Вы можете сохранить их, если хотите обеспечить безопасность типа, но я бы этого не сделал. Вам нужно добавить два новых метода для каждого другого контейнера, который вы хотите поддерживать. Честно говоря, я просто сбросил бы все, кроме Extend и Add, и сделаю Extend Friend, затем создадим только эти два метода .

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
ответил cheezsteak 15 +04002014-10-15T20:11:48+04:00312014bEurope/MoscowWed, 15 Oct 2014 20:11:48 +0400 2014, 20:11:48
10

Вы можете подделать перегрузку, и это сделает для более удобного API. Сначала сделайте FirstWhere и LastWhere частным. Затем добавьте необязательный аргумент в First и Last. Просто проверьте, не существует ли predicate Is Nothing, если он есть, вызовите соответствующий частный метод, иначе запустите код, который возвращает 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
ответил RubberDuck 15 +04002014-10-15T15:49:14+04:00312014bEurope/MoscowWed, 15 Oct 2014 15:49:14 +0400 2014, 15:49:14

Похожие вопросы

Популярные теги

security × 330linux × 316macos × 2827 × 268performance × 244command-line × 241sql-server × 235joomla-3.x × 222java × 189c++ × 186windows × 180cisco × 168bash × 158c# × 142gmail × 139arduino-uno × 139javascript × 134ssh × 133seo × 132mysql × 132