Алгоритм фильтрации списка

Question

Я реализовал, как мне кажется, довольно глупый метод фильтрации System.Collections.ArrayList в VBA.Код принимает список и значение элемента / сравнения для фильтрации.Он проходит по списку и удаляет соответствующие элементы.Затем он перезапускает цикл (потому что вы не можете For Each и .Remove одновременно)

Public Sub Filter(ByVal testValue As Object, ByVal dataSet As ArrayList)
'testValue and the items in `dataSet` all Implement IComparable from mscorlib.dll
'This allows comparing objects for equality
'i.e. obj1.CompareTo(obj2) = 0 is equivalent to obj1 = obj2
    Dim item As IComparable
    Dim repeat As Boolean
    repeat = False
    For Each item In dataSet
        If item.CompareTo(testValue) = 0 Then   'or equiv; If item = testValue
            dataSet.Remove item
            repeat = True
            Exit For
        End If
    Next item
    If repeat Then Filter testValue, dataSet 
End Sub

Почему мусор ?

Скажем,список имеет длину X элементов и содержит Y элементов, которые соответствуют критериям фильтрации, с X>Y.Насколько я могу судить, лучшая производительность в случае O(X), когда все Y сгруппированы в начале.Худший случай, когда все Y сгруппированы в конце.В этом случае алгоритм требует (X-Y)*Y операций поиска, максимум при Y=X/2, поэтому O(X^2)

Это плохо по сравнению с простым O(X) алгоритмом обхода и удаления, когда вы подходите к совпадению, но не разрывая петлю.Пока не знаю, как это реализовать. Есть ли способ улучшить производительность этого фильтра?

Answer 1

Разве вы не можете сделать что-то вроде следующего, что O (n), я считаю:

Option Explicit

Public Sub RemItems()

    Const TARGET_VALUE As String = "dd"
    Dim myList As Object
    Set myList = CreateObject("System.Collections.ArrayList")

    myList.Add "a"
    myList.Add "dd"
    myList.Add "a"
    myList.Add "a"
    myList.Add "a"
    myList.Add "dd"
    myList.Add "a"
    myList.Add "a"
    myList.Add "dd"
    myList.Add "a"
    myList.Add "a"

    Dim i As Long
    For i = myList.Count - 1 To 0 Step -1
        If myList(i) = TARGET_VALUE Then myList.Remove myList(i)
    Next i

End Sub

Для получения информации о сложности см. Это обсуждение:

Асимптотическая сложность.Классы коллекции NET

И если , то этому нужно верить (.NET-Big-O-Algorithm-Complexity-Cheat-Sheet):

Примечание. Я отобразил HTML-код с помощью https://htmledit.squarefree.com/

Редактировать:

Предостережение- Я не выпускник CS.Это играло вокруг.Я уверен, что есть дебаты о том, какой тип данных обрабатывается, распределения и т. Д. ..... Улучшения приветствуются

В приведенной выше таблице .Net показано удаление из HashTable в среднем O(1) для удаления, против O(n) для ArrayList, поэтому я сгенерировал 100 000 строк случайным образом из значений {"a","b","c"}.Затем я использовал это как свой фиксированный набор тестов для следующих результатов.

Код для тестовых прогонов (пожалуйста, будьте осторожны!)

Option Explicit

Private Declare PtrSafe Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long

Public Sub TestingArrayList()
    Const TARGET_VALUE = "a"
    Dim aList As Object
    Set aList = CreateObject("System.Collections.ArrayList")

    Dim arr()
    arr = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion.Value '<== Reads in 100000 value

    Dim i As Long
    For i = 1 To UBound(arr, 1) '50000
        aList.Add arr(i, 2)
    Next i

    Debug.Print aList.Contains(TARGET_VALUE)

    Dim StartTime As Double

    StartTime = MicroTimer()

    For i = aList.Count - 1 To 0 Step -1
       If aList(i) = TARGET_VALUE Then aList.Remove aList(i)
    Next i

    Debug.Print "Removal from array list took: " & Round(MicroTimer - StartTime, 3) & " seconds"
    Debug.Print aList.Contains(TARGET_VALUE)

End Sub

Public Sub TestingHashTable()
    Const TARGET_VALUE = "a"
    Dim hTable As Object
    Set hTable = CreateObject("System.Collections.HashTable")

    Dim arr()
    arr = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion.Value '<== Reads in 100000 value

    Dim i As Long
    For i = 1 To UBound(arr, 1) '50000
        hTable.Add i, arr(i, 2)
    Next i

    Debug.Print hTable.ContainsValue(TARGET_VALUE)

    Dim StartTime As Double

    StartTime = MicroTimer()

    For i = hTable.Count To 1 Step -1
       If hTable(i) = TARGET_VALUE Then hTable.Remove i
    Next i

    Debug.Print "Removal from hash table took: " & Round(MicroTimer - StartTime, 3) & " seconds"
    Debug.Print hTable.ContainsValue(TARGET_VALUE)

End Sub

Public Function MicroTimer() As Double

    Dim cyTicks1 As Currency
    Static cyFrequency As Currency

    MicroTimer = 0

    If cyFrequency = 0 Then getFrequency cyFrequency

    getTickCount cyTicks1

    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Выше было то, что казалось 0 (1).

Если просто посмотреть на процесс удаления (удаление других факторов), результаты были менее убедительными, хотя и сновамоя кодировка может быть фактором!

Пересмотренный код (без учета других факторов):

Option Explicit

Public Sub TestingComparison()

    Const RUN_COUNT As Long = 4

    Dim hTable As Object
    Dim aList As Object
    Dim i As Long, j As Long, k As Long, rowCount As Long
    Dim results() As Double

    Set hTable = CreateObject("System.Collections.HashTable")
    Set aList = CreateObject("System.Collections.ArrayList")

    Dim testSizes()
    testSizes = Array(100, 1000, 10000, 100000)  ', 1000000)
    ReDim results(0 To RUN_COUNT * (UBound(testSizes) + 1) - 1, 0 To 4)

    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("Sheet5")

        For i = LBound(testSizes) To UBound(testSizes)

            For k = 1 To RUN_COUNT

                For j = 1 To testSizes(i)
                    hTable.Add j, 1
                    aList.Add 1
                Next j

                Dim StartTime As Double, completionTime As Double

                StartTime = MicroTimer()

                For j = hTable.Count To 1 Step -1
                    hTable.Remove j
                Next j

                results(rowCount, 3) = Round(MicroTimer - StartTime, 3)
                results(rowCount, 0) = testSizes(i)
                results(rowCount, 1) = k

                StartTime = MicroTimer()

                For j = aList.Count - 1 To 0 Step -1
                    aList.Remove aList(j)
                Next j

                results(rowCount, 2) = Round(MicroTimer - StartTime, 3)

                hTable.Clear
                aList.Clear
                rowCount = rowCount + 1
            Next k

        Next i

        .Range("A2").Resize(UBound(results, 1) + 1, UBound(results, 2)) = results

    End With

    Application.ScreenUpdating = True
End Sub