Question

我希望实现一个VBA trie - 构建算法，该算法能够在相对较短的时间内（少于15-20秒）处理大量的英语词典（约50,000个单词）。由于我是一名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，所以我尝试了基于Dictionary的实现，但是花了相同的时间来完成内存使用率更低（Excel在我的计算机上使用500多MB的RAM）。正如我所说，我对VBA非常陌生，所以我对其语法及其整体特征/限制的了解非常有限 - 这就是为什么我不相信这种算法尽可能高效的原因;任何提示/建议将不胜感激。

提前致谢

注意：代码引用的词典文件“corncob_caps.txt”可用here（下载“所有CAPS”文件）

Answer 1

这里有许多小问题和一些更大的机会。你确实说这是你的第一个vba工作，如果我告诉你你已经知道的事情，请原谅我

小事先：
Dim file, a, b, c As Integer声明文件，a和b作为变体。 Integer是16位符号，因此可能存在溢出风险，请改用Long。

内部循环中的

DIM会适得其反：与C ++不同，它们不是循环范围的。

真正的机会是：

使用For Each来迭代集合：它比索引更快。

在我的硬件上，您的原始代码在大约160秒内运行。此代码大约2.5s（加上时间加载word文件到集合中，大约4s）

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

编辑：

将单词列表加载到动态数组中会将加载时间减少到亚秒级。请注意，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迭代Collection应该比使用VBA更快一些：

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的全部功能。它是一个键值映射，而不仅仅是一个可调整大小的数组。如果将字母用作键，则可能会获得更好的性能，但查找不存在的键会引发错误，因此您必须使用丑陋的错误解决方法来检查每个节点。 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

编辑：最后的优化策略，使用Asc函数获取Integer char值并存储而不是String。

Answer 3

您确实需要对其进行分析，但如果您认为收藏速度很慢，您可以尝试使用dynamic arrays吗？

有什么方法可以加快这个VBA算法的速度吗？

3 个答案: