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

Question

Я собираюсь реализовать алгоритм построения VBA trie , способный обрабатывать существенную лексику английского языка (~ 50 000 слов) за относительно короткое время (менее 15-20 секунд). Так как я на практике программист на C ++ (и я впервые делаю какую-либо существенную работу на VBA), я создал быструю проверочную программу, которая смогла выполнить задачу на моем компьютере примерно за полсекунды. Однако, когда пришло время протестировать порт VBA, потребовалось почти две минуты, чтобы сделать то же самое - недопустимо много времени для моих целей. Код VBA ниже:

Модуль класса узла:

Public letter As String
Public next_nodes As New Collection
Public is_word As Boolean

Основной модуль:

Dim tree As Node

Sub build_trie()
    Set tree = New Node
    Dim file, a, b, c As Integer
    Dim current As Node
    Dim wordlist As Collection
    Set wordlist = New Collection
    file = FreeFile
    Open "C:\corncob_caps.txt" For Input As file
    Do While Not EOF(file)
        Dim line As String
        Line Input #file, line
        wordlist.add line
    Loop
    For a = 1 To wordlist.Count
        Set current = tree
        For b = 1 To Len(wordlist.Item(a))
            Dim match As Boolean
            match = False
            Dim char As String
            char = Mid(wordlist.Item(a), b, 1)
            For c = 1 To current.next_nodes.Count
                If char = current.next_nodes.Item(c).letter Then
                    Set current = current.next_nodes.Item(c)
                    match = True
                    Exit For
                End If
            Next c
            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 a
End Sub

Тогда мой вопрос прост: можно ли ускорить этот алгоритм? Из некоторых источников я видел, что VBA Collection не так эффективны, как Dictionary s, и поэтому я попытался вместо этого реализовать реализацию на основе Dictionary, но потребовалось такое же количество времени, чтобы завершиться с еще худшим использованием памяти (500+ МБ ОЗУ используется Excel на моем компьютере). Как я уже сказал, я чрезвычайно новичок в VBA, поэтому мои знания как о его синтаксисе, так и о его общих возможностях / ограничениях очень ограничены - вот почему я не верю, что этот алгоритм настолько эффективен, насколько это возможно; Любые советы / предложения будут с благодарностью.

Заранее спасибо

NB: Файл лексики, на который ссылается код "corncob_caps.txt", доступен здесь (загрузить файл "all CAPS")

Answer 1

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

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

DIM использование внутренних циклов неэффективно: в отличие от C ++ они не имеют циклической области.

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

Используйте 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)

Answer 2

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

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, а не просто массив с изменяемым размером. Вы можете получить более высокую производительность, если будете использовать букву в качестве ключа, хотя поиск ключа, которого нет, выдает ошибку, поэтому вы должны использовать обходной путь для проверки каждого узла. Внутренняя часть цикла 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

Таким образом, вам не понадобится переменная letter в классе 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 с функцией Asc и сохранить его вместо String.

Answer 3

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