空腹おやじのログと備忘録

VBA(主にExcel)でいろいろな実験的な事とか、Linuxのコマンドとか設定とかについて忘れないように、あれこれと・・・

【VBA】トライ木を使って、文字列Aにある文字列Bを数えてみた

トライ木とは

人に説明できるだけ理解していないので、Wikipediaより抜粋。

順序付き木の一種。あるノードの配下の全ノードは、自身に対応する文字列に共通するプレフィックス(接頭部)があり、ルート(根)には空の文字列が対応している。値は一般に全ノードに対応して存在するわけではなく、末端ノードや一部の中間ノードだけがキーに対応した値を格納している。2分探索木と異なり、各ノードに個々のキーが格納されるのではなく、木構造上のノードの位置とキーが対応している。

https://ja.wikipedia.org/wiki/%E3%83%88%E3%83%A9%E3%82%A4_(%E3%83%87%E3%83%BC%E3%82%BF%E6%A7%8B%E9%80%A0)

ja.wikipedia.org

コード

トライ木

クラスモジュール:CTrie

Option Explicit

Private Const BASE As Long = 65&

Public val  As Long
Private nxt_(25) As CTrie

Public Property Get nxt(ByVal index As Long) As CTrie

    Set nxt = nxt_(index)

End Property

Public Function createNxt(ByVal index As Long) As CTrie

    Set nxt_(index) = New CTrie

    Set createNxt = nxt_(index)

End Function

Public Sub instert(ByVal s As String)

    Dim cur As CTrie
    Dim i   As Long

    Set cur = Me

    For i = 1 To Len(s)
        If cur.nxt(Asc(Mid(s, i, 1)) - BASE) Is Nothing Then
            Call cur.createNxt(Asc(Mid(s, i, 1)) - BASE)
        End If

        Set cur = cur.nxt(Asc(Mid(s, i, 1)) - BASE)
    Next i
    cur.val = cur.val + 1
End Sub

Public Function exitsIn(ByVal s As String) As Boolean

    Dim cur As CTrie
    Dim ss As String
    Dim i   As Long

    For i = 1 To Len(s)
        Set cur = Me

        ss = Mid(s, i)

        Do While Len(ss) > 0 And (Not cur Is Nothing)
            Set cur = cur.nxt(Asc(Left(ss, 1)) - BASE)

            If Not cur Is Nothing Then
                If cur.val > 0 Then
                    exitsIn = True
                    Exit Function
                End If
            End If

            If Len(ss) < 2 Then
                Exit Do
            End If
            ss = Mid(ss, 2)
        Loop
    Next i

    exitsIn = False

End Function

Public Function count(ByVal s As String) As Long

    Dim cur     As CTrie
    Dim lCount  As Long
    Dim ss      As String
    Dim i       As Long

    For i = 1 To Len(s)
        Set cur = Me

        ss = Mid(s, i)

        Do While Len(ss) > 0 And (Not cur Is Nothing)
            Set cur = cur.nxt(Asc(Left(ss, 1)) - BASE)

            If Not cur Is Nothing Then
                lCount = lCount + cur.val
            End If

            If Len(ss) < 2 Then
                Exit Do
            End If
            ss = Mid(ss, 2)
        Loop
    Next i

    count = lCount

End Function

標準モジュール(クラスモジュールの呼び出し)

Sub fuga()

    Dim tr As CTrie
    Dim sPath As String
    Dim iFNo    As Integer
    Dim s As String
    Dim ss As String
    Dim cnt As Long
    Dim i   As Long

    Dim sw  As New CStopWatch
    Dim start As LongLong
    Dim stp As LongLong

    start = sw.GetValueOfTickCnt

    sPath = "C:\Datas\sample.txt"
    iFNo = FreeFile

    Open sPath For Input Access Read As iFNo

    Line Input #iFNo, s
    Line Input #iFNo, ss
    cnt = CLng(ss)

    Set tr = New CTrie
    For i = 0 To cnt - 1
        Line Input #iFNo, ss
        tr.instert ss
    Next i

    Close iFNo

    Debug.Print "Trie"
    Debug.Print "Result:" & tr.count(s)

    stp = sw.GetValueOfTickCnt
    Debug.Print "Time  :" & stp - start & " [msec]"

End Sub
InStr
Sub piyo()

    Dim sPath As String
    Dim iFNo    As Integer
    Dim s As String
    Dim ss As String
    Dim cnt As Long
    Dim c() As String
    Dim pos As Long
    Dim lResult As Long
    Dim i   As Long

    Dim sw  As New CStopWatch
    Dim start As LongLong
    Dim stp As LongLong

    start = sw.GetValueOfTickCnt

    sPath = "C:\Datas\sample.txt"
    iFNo = FreeFile

    Open sPath For Input Access Read As iFNo

    Line Input #iFNo, s
    Line Input #iFNo, ss
    cnt = CLng(ss)
    ReDim c(cnt - 1)

    For i = 0 To cnt - 1
        Line Input #iFNo, ss
        c(i) = ss
    Next i

    Close iFNo

    For i = 0 To cnt - 1
        pos = 1

        Do
            pos = InStr(pos, s, c(i))

            If pos > 0 Then
                lResult = lResult + 1

                pos = pos + 1
            End If
        Loop Until pos = 0
    Next i

    stp = sw.GetValueOfTickCnt

    Debug.Print "Instr"
    Debug.Print "Result:" & lResult
    Debug.Print "Time  :" & stp - start & " [msec]"

End Sub
Sub hoge()

    Dim i As Long

    For i = 1 To 10
        Call fuga
        Call piyo
    Next i

End Sub

結果

テストデータ

yukicoder の、No.430 文字列検索テストデータ より、challege02.txt を使用してみた。

文字数:50,000
検索対象文字:5,000個(ランダム文字列)

こんな感じ(一部のみ)
f:id:Z1000S:20201104113824p:plain
5000の上が、検索元となるデータ文字列
5000の下が、検索文字列

結果

hoge の実行結果、トライ木は、InStr の約2倍の時間がかかりました。
トライ木が、InStrの約3割程度の時間で処理できた。

個人的には、トライ木が速いというよりも、
InStr が、予想以上に速かったという感想。

コメントによるご指摘により、計測位置が間違っている事が判明したため、下記のデータを含めて修正しました。(2020/11/4 16:30)

  Trie木 InStr
1547250
2547265
3547281
4562265
5516281
6500281
7500265
8532266
9484265
10500266
平均 [msec] 523 268
f:id:Z1000S:20201104163302p:plain

ちなみに、C++で実装したら、6 msec でした。