Есть ли способ ускорить этот алгоритм VBA?

Ответ 1

Здесь есть несколько мелких проблем и несколько больших возможностей. Вы сказали, что это ваша первая работа в vba, так что простите меня, если я расскажу вам то, что вы уже знаете.

Маленькие вещи:
Dim file, a, b, c As Integer объявляет файлы, а и b как варианты. Integer - это 16-битный знак, поэтому может возникнуть риск переполнения, вместо этого используйте Long.

DIM Внутренние циклы контрпродуктивны: в отличие от С++ они не охватываются контуром.

Реальная возможность:

Используйте For Each, где вы можете выполнять итерирование коллекций: быстрее, чем индексирование.

На моем оборудовании ваш исходный код работал примерно за 160 секунд. Этот код примерно в 2,5 с (оба плюс время для загрузки файла слов в коллекцию, около 4 с)

Sub build_trie()
    Dim t1 As Long
    Dim wd As Variant
    Dim nd As Node

    Set tree = New Node
    ' Dim file, a, b, c As Integer  : declares file, a, b as variant
    Dim file As Integer, a As Long, b As Long, c As Long     ' Integer is 16 bit signed

    Dim current As Node
    Dim wordlist As Collection
    Set wordlist = New Collection
    file = FreeFile
    Open "C:\corncob_caps.txt" For Input As file

    ' no point in doing inside loop, they are not scoped to the loop
    Dim line As String
    Dim match As Boolean
    Dim char As String
    Dim new_node As Node

    Do While Not EOF(file)
        'Dim line As String
        Line Input #file, line
        wordlist.Add line
    Loop


    t1 = GetTickCount
    For Each wd In wordlist ' for each is faster
    'For a = 1 To wordlist.Count
        Set current = tree
        For b = 1 To Len(wd)
            'Dim match As Boolean
            match = False
            'Dim char As String
            char = Mid$(wd, b, 1)
            For Each nd In current.next_nodes
            'For c = 1 To current.next_nodes.Count
                If char = nd.letter Then
                'If char = current.next_nodes.Item(c).letter Then
                    Set current = nd
                    'Set current = current.next_nodes.Item(c)
                    match = True
                    Exit For
                End If
            Next nd
            If Not match Then
                'Dim new_node As Node
                Set new_node = New Node
                new_node.letter = char
                current.next_nodes.Add new_node
                Set current = new_node
            End If
        Next b
        current.is_word = True
    Next wd

    Debug.Print "Time = " & GetTickCount - t1 & " ms"
End Sub

EDIT:

Загрузка списка слов в динамический массив уменьшит время загрузки до второй секунды. Имейте в виду, что Redim Preserve стоит дорого, так что сделайте это в кусках

    Dim i As Long, sz As Long
    sz = 10000
    Dim wordlist() As String
    ReDim wordlist(0 To sz)

    file = FreeFile
    Open "C:\corncob_caps.txt" For Input As file

    i = 0
    Do While Not EOF(file)
        'Dim line As String
        Line Input #file, line
        wordlist(i) = line
        i = i + 1
        If i > sz Then
            sz = sz + 10000
            ReDim Preserve wordlist(0 To sz)
        End If
        'wordlist.Add line
    Loop
    ReDim Preserve wordlist(0 To i - 1)

затем пропустите его, как

    For i = 0 To UBound(wordlist)
        wd = wordlist(i)

Ответ 2

Я не в курсе с VBA, но IIRC, итерация коллекции, использующей For Every, должна быть немного быстрее, чем численно:

Dim i As Variant
For Each i In current.next_nodes
    If i.letter = char Then
        Set current = i
        match = True
        Exit For
    End If
Next node

Вы также не используете полные возможности Collection. Это карта Key-Value, а не только масштабируемый массив. Если вы используете букву в качестве ключа, вы можете получить более высокую производительность, хотя поиск ключа, который отсутствует, вызывает ошибку, поэтому вам нужно использовать уродливое обходное решение ошибки для проверки каждого node. Внутренняя часть цикла b будет выглядеть так:

Dim char As String
char = Mid(wordlist.Item(a), b, 1)
Dim node As Node
On Error Resume Next
Set node = Nothing
Set node = current.next_nodes.Item(char)
On Error Goto 0
If node Is Nothing Then
    Set node = New Node
    current.next_nodes.add node, char
Endif
Set current = node

Вам не понадобится переменная букв в классе Node.

Я не тестировал это. Надеюсь, все в порядке...

Изменить: Исправлен цикл For Each.

Еще одна вещь, которую вы можете сделать, которая, возможно, будет медленнее, но будет использовать меньше памяти, - это использование массива вместо коллекции и изменение размера с каждым добавленным элементом. Массивы не могут быть общедоступными в классах, поэтому вам нужно добавить методы в класс, чтобы справиться с ним:

Public letter As String
Private next_nodes() As Node
Public is_word As Boolean

Public Sub addNode(new_node As Node)
    Dim current_size As Integer
    On Error Resume Next
    current_size = UBound(next_nodes) 'ubound throws an error if the array is not yet allocated
    On Error GoTo 0
    ReDim next_nodes(0 To current_size) As Node
    Set next_nodes(current_size) = new_node
End Sub

Public Function getNode(letter As String) As Node
    Dim n As Variant
    On Error Resume Next
    For Each n In next_nodes
        If n.letter = letter Then
            Set getNode = n
            Exit Function
        End If
    Next
End Function

Изменить: и окончательную стратегию оптимизации, получите значение Integer char с помощью функции Asc и сохраните это вместо строки.

Ответ 3

Вам действительно нужно профилировать его, но если вы считаете, что коллекции медленны, возможно, вы можете попробовать использовать динамические массивы?