"Fat Fingering" Query (1 Viewer)

Function Levenshtein(ByVal str1 As String, ByVal str2 As String) As Integer
 
Dim arrLev() As Integer
Dim intLen1 As Integer
Dim intLen2 As Integer
Dim i As Integer
Dim j As Integer
Dim arrStr1() As Integer
Dim arrStr2() As Integer
Dim intMini As Integer
 
    intLen1 = Len(str1)
    ReDim arrStr1(intLen1 + 1)
    intLen2 = Len(str2)
    ReDim arrStr2(intLen2 + 1)
    ReDim arrLev(intLen1 + 1, intLen2 + 1)
 
    arrLev(0, 0) = 0
    For i = 1 To intLen1
        arrLev(i, 0) = i
        arrStr1(i) = Mid(str1, i, 1)
    Next
 
    For j = 1 To intLen2
        arrLev(0, j) = j
        arrStr2(j) = Mid(str2, j, 1)
    Next
 
    For j = 1 To intLen2
        For i = 1 To intLen1
            If arrStr1(i) = arrStr2(j) Then
                arrLev(i, j) = arrLev(i - 1, j - 1)
            Else
                intMini = arrLev(i - 1, j) 'deletion
                If intMini > arrLev(i, j - 1) Then intMini = arrLev(i, j - 1) 'insertion
                If intMini > arrLev(i - 1, j - 1) Then intMini = arrLev(i - 1, j - 1) 'deletion
 
                arrLev(i, j) = intMini + 1
            End If
        Next
    Next
 
    Levenshtein = arrLev(intLen1, intLen2)
End Function

Public Function WeightedDL(ByVal source As String, ByVal target As String) As Double
 
Const deleteCost = 1
Const insertCost = 1.1
Const replaceCost = 1.1
Const swapCost = 1.2
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
 
Dim deleteDistance As Double
Dim insertDistance As Double
Dim matchDistance As Double
Dim maxSourceLetterMatchIndex As Integer
Dim table() As Double
Dim sourceIndexByCharacter() As Variant
Dim candidateSwapIndex As Integer
Dim jSwap As Integer
Dim swapDistance As Double
Dim iSwap As Integer
Dim preSwapCost As Double
 
    If Len(source) = 0 Then
        WeightedDL = Len(target) * insertCost
        Exit Function
    End If
 
    If Len(target) = 0 Then
        WeightedDL = Len(source) * deleteCost
        Exit Function
    End If
 
    ReDim table(Len(source), Len(target))
    ReDim sourceIndexByCharacter(0 To 1, 0 To Len(source) - 1)
 
    If Left(source, 1) <> Left(target, 1) Then
        table(0, 0) = MinOf(replaceCost, (deleteCost + insertCost))
    End If
 
    sourceIndexByCharacter(0, 0) = Left(source, 1)
    sourceIndexByCharacter(1, 0) = 0
 
    For i = 1 To Len(source) - 1
 
        deleteDistance = table(i - 1, 0) + deleteCost
        insertDistance = ((i + 1) * deleteCost) + insertCost
 
        If Mid(source, i + 1, 1) = Left(target, 1) Then
            matchDistance = (i * deleteCost) + 0
        Else
            matchDistance = (i * deleteCost) + replaceCost
        End If
 
        table(i, 0) = MinOf(MinOf(deleteDistance, insertDistance), matchDistance)
    Next
 
    For j = 1 To Len(target) - 1
 
        deleteDistance = table(0, j - 1) + insertCost
        insertDistance = ((j + 1) * insertCost) + deleteCost
 
        If Left(source, 1) = Mid(target, j + 1, 1) Then
            matchDistance = (j * insertCost) + 0
        Else
            matchDistance = (j * insertCost) + replaceCost
        End If
 
        table(0, j) = MinOf(MinOf(deleteDistance, insertDistance), matchDistance)
    Next
 
    For i = 1 To Len(source) - 1
 
        If Mid(source, i + 1, 1) = Left(target, 1) Then
            maxSourceLetterMatchIndex = 0
        Else
            maxSourceLetterMatchIndex = -1
        End If
 
        For j = 1 To Len(target) - 1
            candidateSwapIndex = -1
 
            For k = 0 To UBound(sourceIndexByCharacter, 2)
 
                If sourceIndexByCharacter(0, k) = Mid(target, j + 1, 1) Then candidateSwapIndex = sourceIndexByCharacter(1, k)
            Next
 
            jSwap = maxSourceLetterMatchIndex
            deleteDistance = table(i - 1, j) + deleteCost
            insertDistance = table(i, j - 1) + insertCost
            matchDistance = table(i - 1, j - 1)
 
            If Mid(source, i + 1, 1) <> Mid(target, j + 1, 1) Then
                matchDistance = matchDistance + replaceCost
            Else
                maxSourceLetterMatchIndex = j
            End If
 
            If candidateSwapIndex <> -1 And jSwap <> -1 Then
                iSwap = candidateSwapIndex
 
                If iSwap = 0 And jSwap = 0 Then
                    preSwapCost = 0
                Else
                    preSwapCost = table(MaxOf(0, iSwap - 1), MaxOf(0, jSwap - 1))
                End If
 
                swapDistance = preSwapCost + ((i - iSwap - 1) * deleteCost) + ((j - jSwap - 1) * insertCost) + swapCost
 
            Else
                swapDistance = 500
            End If
 
            table(i, j) = MinOf(MinOf(MinOf(deleteDistance, insertDistance), matchDistance), swapDistance)
 
        Next
 
        sourceIndexByCharacter(0, i) = Mid(source, i + 1, 1)
        sourceIndexByCharacter(1, i) = i
    Next
 
    WeightedDL = table(Len(source) - 1, Len(target) - 1)
 
End Function
 
Public Function MinOf(ByVal Value1 As Double, ByVal Value2 As Double) As Double
 
    If Value1 > Value2 Then
        MinOf = Value2
    Else
        MinOf = Value1
    End If
 
End Function
 
Public Function MaxOf(ByVal Value1 As Double, ByVal Value2 As Double) As Double
 
    If Value1 < Value2 Then
        MaxOf = Value2
    Else
        MaxOf = Value1
    End If
 
End Function