Levenshtein distance - Code Snippets - WikibooksVBA (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
Scheduling Jobs in SQL Server Express - SQLTeam.com
