ホーム > ライブラリ > DIFF > Diff

ライブラリ

Diff

Diff のアルゴリズム (Myers) ※もちろんVBAで実装

差分を計算するというのは次の3つを計算すること
LD (LevenshteinDistance)=編集距離   :2つの要素列の違いを数値化したもの
LCS(Longest Common Subsequence) :2つの要素列の最長共通部分列
SES(Shortest Edit Script)                  :ある要素列を別の要素列に変換するための最短手順

Public Enum E_Diff_Snake
    None
    Horizontal
    Vertical
    Diagonal
End Enum

Private Function pSample()
    
    Dim aStr    As String
    Dim bStr    As String
    aStr = "ABCBA"
    bStr = "ACBCAB"
    
    '文字列を1文字単位で配列化
    Dim aChr()  As String
    Dim bChr()  As String
    aChr = Diff_String_to_Chars(aStr)
    bChr = Diff_String_to_Chars(bStr)
    
    '編集距離(LD),変更手順(SES)を取得
    Dim LD      As Long
    Dim Sn()    As E_Diff_Snake
    LD = Diff_LD(aChr, bChr, Sn)
    
    '類似点を計算
    Dim Per As Long
    Per = Diff_Per(LD, Len(aStr), Len(bStr))
    
    '異なる文字を取得
    Call Diff_Snake(Sn, aChr, bChr)
    
End Function

Public Function Diff_String_to_Chars(Str As String) As String()
    
    If Len(Str) = 0 Then Exit Function
    
    Dim Chars() As String
    ReDim Chars(0 To Len(Str) - 1)
    
    Dim i   As Long
    For i = 1 To Len(Str)
        Chars(i - 1) = Mid$(Str, i, 1)
    Next
    
    Diff_String_to_Chars = Chars
    
End Function

Public Function Diff_Per(LD As Long, aLen As Long, bLen As Long) As Long
    
    Dim Precision   As Long
    Dim EditPer     As Long
    Dim LenAB       As Long
    
    LenAB = aLen + bLen
    
    'レーベンシュタイン距離(編集距離)を、比較文字列[A][B]の合計文字長で割り、編集パーセントを試算
    If LenAB > 0 Then
        EditPer = LD * 100 / LenAB
    End If
    
    '類似度を返したいので、100%-上記の編集度を引く
    Precision = 100 - EditPer
    
    Diff_Per = Precision
    
End Function

Public Function Diff_LD(aChars() As String, bChars() As String, Optional Sn As Variant) As Long
'Myers のアルゴリズム O(ND)
    
    Dim LD  As Long '編集距離:LevenshteinDistance
    
    '文字列の長さを取得
    Dim aLen As Long, bLen As Long
    aLen = UBound(aChars, 1) - LBound(aChars, 1) + 1
    bLen = UBound(bChars, 1) - LBound(bChars, 1) + 1
    If bLen = 0 Or aLen = 0 Then
        LD = bLen - aLen
        GoTo Finish
    End If
    
    'その他、準備
    Dim LenAB   As Long
    LenAB = aLen + bLen
    
    Dim V()    As Long
    ReDim V(-LenAB To LenAB)
    
    Dim d   As Long
    Dim k   As Long
    Dim bi  As Long
    Dim ai  As Long
    Dim s   As E_Diff_Snake
    
    ReDim Sn(aLen, bLen) As E_Diff_Snake
    
    For d = 0 To LenAB
        
        For k = -d To d Step 2
            
            If -aLen <= k Then
                If k <= bLen Then
                    
                    '縦範囲の境界
                    If IIf(d < aLen, d, aLen) = -k Then
                        bi = V(k + 1)
                        s = E_Diff_Snake.Vertical
                    
                    '横範囲の境界
                    ElseIf IIf(d < bLen, d, bLen) = k Then
                        bi = V(k - 1) + 1
                        s = E_Diff_Snake.Horizontal
                        
                    'その間
                    Else
                        
                        If V(k + 1) < V(k - 1) + 1 Then
                            bi = V(k - 1) + 1
                            s = E_Diff_Snake.Horizontal
                        Else
                            bi = V(k + 1)
                            s = E_Diff_Snake.Vertical
                        End If
                        
                    End If
                    
                    ai = bi - k
                    
                    If ai <= aLen Then
                        If bi <= bLen Then
                            Sn(ai, bi) = s
                        End If
                    End If
                    
                    Do
                        If ai >= aLen Then Exit Do
                        If bi >= bLen Then Exit Do
                        If aChars(ai) <> bChars(bi) Then Exit Do
                        ai = ai + 1
                        bi = bi + 1
                        Sn(ai, bi) = E_Diff_Snake.Diagonal
                    Loop
                    
                    V(k) = bi
                    
                    '- 到達したときの編集距離を返す
                    If ai >= aLen Then
                        If bi >= bLen Then
                            LD = d
                            GoTo Finish
                        End If
                    End If
                    
                End If
            End If
            
        Next
        
    Next
    
Finish: Diff_LD = LD
    
End Function

Public Function Diff_Snake(Sn() As E_Diff_Snake, _
                           ByRef aChars() As String, ByRef bChars() As String, _
                           Optional RetDiff As Boolean = True, _
                           Optional OutA As Boolean = True, _
                           Optional OutB As Boolean = True)
'snake
    
    Dim aLen As Long, bLen As Long
    aLen = UBound(aChars, 1) - LBound(aChars, 1) + 1
    bLen = UBound(bChars, 1) - LBound(bChars, 1) + 1
    
    '文字列が無い場合、終了
    If aLen = 0 Or bLen = 0 Then Exit Function
    
    Dim ai      As Long
    Dim bi      As Long
    ai = aLen - 1
    bi = bLen - 1
    
    While (0 <= ai And 0 <= bi)
        
        Select Case Sn(ai + 1, bi + 1)
        
        '斜線
        Case E_Diff_Snake.Diagonal
            
            '同じ文字を消去
            If RetDiff = True Then
                If OutA Then aChars(ai) = Empty
                If OutB Then bChars(bi) = Empty
            End If
            
            ai = ai - 1
            bi = bi - 1
            
        '横
        Case E_Diff_Snake.Horizontal
            
            If RetDiff = False Then
                If OutB Then bChars(bi) = Empty
            End If
            
            bi = bi - 1
            
        '縦
        Case E_Diff_Snake.Vertical
            
            If RetDiff = False Then
                If OutA Then aChars(ai) = Empty
            End If
            
            ai = ai - 1
            
        Case Else
            
            If RetDiff = False Then
                If OutA Then aChars(ai) = Empty
                If OutB Then bChars(bi) = Empty
            End If
            
            ai = ai - 1
            bi = bi - 1
            
        End Select
        
    Wend
    
    If RetDiff = False Then
        Do
            If ai < 0 Then Exit Do
            If OutA Then aChars(ai) = Empty
            ai = ai - 1
        Loop
        Do
            If bi < 0 Then Exit Do
            If OutB Then bChars(bi) = Empty
            bi = bi - 1
        Loop
    End If
    
End Function

DIFF   2017/06/19   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください