Longest common substring - Code Snippets - Wikibooks

Longest common substring - Code Snippets - Wikibooks

Public Function LongestCommonSubstring(ByVal s1 As String, ByVal s2 As String) As Integer
     Dim num(s1.Length - 1, s2.Length - 1) As Integer   '2D array
     Dim letter1 As Char = Nothing
     Dim letter2 As Char = Nothing
     Dim len As Integer = 0
     Dim ans As Integer = 0
     For i As Integer = 0 To s1.Length - 1
         For j As Integer = 0 To s2.Length - 1
             letter1 = s1.Chars(i)
             letter2 = s2.Chars(j)
             If Not letter1.Equals(letter2) Then
                 num(i, j) = 0
             Else
                 If i.Equals(0) Or j.Equals(0) Then
                     num(i, j) = 1
                 Else
                     num(i, j) = 1 + num(i - 1, j - 1)
                 End If
                 If num(i, j) > len Then
                     len = num(i, j)
                     ans = num(i, j)
                 End If
             End If
         Next j
     Next i
     Return ans
 End Function

Levenshtein distance - Code Snippets - Wikibooks

Levenshtein distance - Code Snippets - Wikibooks

VBA (with Damerau extension)
This VBA version uses recursion and a maximum allowed distance. The analysis to identify quasi-duplicated strings or spelling mistakes can be narrowed down to a corridor in the result matrix. The Damerau extension has also been added to the Levenshtein algorithm.

Function damerau_levenshtein(s1 As String, s2 As String, Optional limit As Variant, Optional result As Variant) As Integer
'This function returns the Levenshtein distance capped by the limit parameter.
'Usage : e.g. damerau_levenshtein("Thibault","Gorisse") to get the exact distance
' or damerau_levenshtein("correctly written words","corectly writen words",4) to identify similar spellings

    Dim diagonal As Integer
    Dim horizontal As Integer
    Dim vertical As Integer
    Dim swap As Integer
    Dim final As Integer

    'set a maximum limit if not set
    If IsMissing(limit) Then
        limit = Len(s1) + Len(s2)
    End If

    'create the result matrix to store intermediary results
    If IsMissing(result) Then
        Dim i, j As Integer ' pointeur
        ReDim result(Len(s1), Len(s2)) As Integer
    End If

    'Start of the strings analysis
    If result(Len(s1), Len(s2)) <>= limit Then
            final = limit
        Else
            If Len(s1) = 0 Or Len(s2) = 0 Then
                'End of recursivity
                final = Len(s1) + Len(s2)
            Else

                'Core of levenshtein algorithm
                If Mid(s1, 1, 1) = Mid(s2, 1, 1) Then
                    final = damerau_levenshtein(Mid(s1, 2), Mid(s2, 2), limit, result)
                Else

                    If Mid(s1, 1, 1) = Mid(s2, 2, 1) And Mid(s1, 2, 1) = Mid(s2, 1, 1) Then
                        'Damerau extension counting swapped letters
                        swap = damerau_levenshtein(Mid(s1, 3), Mid(s2, 3), limit - 1, result)
                        final = 1 + swap
                    Else
                        'The function minimum is implemented via the limit parameter.
                        'The diagonal search usually reaches the limit the quickest.
                        diagonal = damerau_levenshtein(Mid(s1, 2), Mid(s2, 2), limit - 1, result)
                        horizontal = damerau_levenshtein(Mid(s1, 2), s2, diagonal, result)
                        vertical = damerau_levenshtein(s1, Mid(s2, 2), horizontal, result)
                        final = 1 + vertical
                    End If
                End If

            End If
        End If
    Else
        'retrieve intermediate result
        final = result(Len(s1), Len(s2)) - 1
    End If

    'returns the distance capped by the limit
    If final < limit Then
        damerau_levenshtein = final
        'store intermediate result
        result(Len(s1), Len(s2)) = final + 1
    Else
        damerau_levenshtein = limit
    End If

End Function