Levenshtein Distance II

Category: Strings

Date: 03-28-2012

Return to Index


 
Sub ShowDifference(ByVal txt1 As String, ByVal txt2 As String)
   'Credit: Rod Stephens
   ' Costs for adding or replacing lines.
   #Register None
   Register i1 As Long
   Register i2 As Long
   Local i,j, len1,len2,num_moves, dist_repl, dist_add1, dist_add2 As Long
   Dim move_sequence() As Long
 
 
   ' Split the strings into arrays of lines.
   ' We add a vbCrLf at the front so we get an
   ' extra blank string in array entry 0.
 
   If IgnoreCase Then txt1 = LCase$(txt1) : txt2 = LCase$(txt2)
 
   Dim lines1 (1 To ParseCount(txt1,$CrLf)) As String
   Dim lines2 (1 To ParseCount(txt2,$CrLf)) As String
   Dim NLines1 (1 To UBound(lines1)) As String
   Dim NLines2 (1 To UBound(lines2)) As String
 
   Parse txt1$, lines1(), $CrLf
   Parse txt2$, lines2(), $CrLf
   Parse TextLeft, Nlines1(), $CrLf
   Parse TextRight, Nlines2(), $CrLf
 
   If IgnoreTrailing Then
      For i = 1 To UBound(lines1) : lines1(i) = RTrim$(lines1(i)) : Next i
      For i = 1 To UBound(lines2) : lines2(i) = RTrim$(lines2(i)) : Next i
   End If
 
   ' Allocate space for the distances
   ' and moves arrays.
   len1 = UBound(lines1)
   len2 = UBound(lines2)
   Dim distances(0 To len1, 0 To len2) As Long
   Dim moves(0 To len1, 0 To len2) As Long
 
   ' Initialize the arrays.
   moves(0, 0) = %move_NoChange
   For i1 = 1 To len1
      distances(i1, 0) = distances(i1 - 1, 0) + %COST_ADD1
      moves(i1, 0) = %move_Add1
   Next i1
   For i2 = 1 To len2
      distances(0, i2) = distances(0, i2 - 1) + %COST_ADD2
      moves(0, i2) = %move_Add2
   Next i2
 
   ' Fill in the rest of the arrays.
   For i1 = 1 To len1
      For i2 = 1 To len2
         ' See how much it would cost to start
         ' from the (i1 - 1, i2 - 1) entry.
         If lines1(i1) = lines2(i2) Then
            dist_repl = distances(i1 - 1, i2 - 1)
         Else
            dist_repl = distances(i1 - 1, i2 - 1) + %COST_REPL
         End If
 
         ' See how much it would cost to start
         ' from the (i1 - 1, i2) and (i1, i2 - 1)
         ' entries.
         dist_add1 = distances(i1 - 1, i2) + %COST_ADD1
         dist_add2 = distances(i1, i2 - 1) + %COST_ADD2
 
         ' See which method is cheapest.
         If (dist_repl <= dist_add1) And (dist_repl <= dist_add2) Then
            distances(i1, i2) = dist_repl
            If lines1(i1) = lines2(i2) Then
               moves(i1, i2) = %move_NoChange
            Else
               moves(i1, i2) = %move_Replace
            End If
         ElseIf (dist_add1 <= dist_repl) And (dist_add1 <= dist_add2) Then
            distances(i1, i2) = dist_add1
            moves(i1, i2) = %move_Add1
         Else
            distances(i1, i2) = dist_add2
            moves(i1, i2) = %move_Add2
         End If
      Next i2
   Next i1
 
   ' Make a list of the moves we took
   ' (in reverse order).
   i1 = len1
   i2 = len2
   Do While (i1 > 0) Or (i2 > 0)
      ' Save the move.
      num_moves = num_moves + 1
      ReDim Preserve move_sequence(1 To num_moves)
      move_sequence(num_moves) = moves(i1, i2)
 
      ' Go to the previous position in the array.
      Select Case moves(i1, i2)
         Case %move_NoChange
            i1 = i1 - 1
            i2 = i2 - 1
         Case %move_Replace
            i1 = i1 - 1
            i2 = i2 - 1
         Case %move_Add1
            i1 = i1 - 1
         Case %move_Add2
            i2 = i2 - 1
      End Select
   Loop
 
   ' Use the moves to build the result string.
   i1 = 1
   i2 = 1
 
   ReDim LeftColor(1 To num_moves), RightColor(1 To num_moves)
   ListView Reset hDlg, %IDC_ListViewL
   ListView Reset hDlg, %IDC_ListViewR
 
   For i = 1 To num_moves
       ListView Insert Item hDlg, %IDC_ListViewL,i,0,Format$(i,"0000")
       ListView Insert Item hDlg, %IDC_ListViewR,i,0,Format$(i,"0000")
   Next i
 
   Statusbar Set Text hDlg, %IDC_StatusBar, 1, 0, "Moves = " + Str$(num_moves)
 
   For i = num_moves To 1 Step -1
      j = num_moves - i + 1
      Select Case move_sequence(i)
         Case %move_Add1
            ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
            ListView Set Text hDlg, %IDC_ListViewR,j,2,""
            RightColor(j) = RGB(230,230,230)
            LeftColor(j) = UniqueColor
            i1 = i1 + 1
         Case %move_Add2
            ListView Set Text hDlg, %IDC_ListViewL,j,2,""
            ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
            RightColor(j) = UniqueColor
            LeftColor(j) = RGB(230,230,230)
            i2 = i2 + 1
         Case %move_Replace
            ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
            ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
            RightColor(j) = DiffColor
            LeftColor(j) = DiffColor
            i1 = i1 + 1
            i2 = i2 + 1
         Case %move_NoChange
            ListView Set Text hDlg, %IDC_ListViewL,j,2,Nlines1(i1)
            ListView Set Text hDlg, %IDC_ListViewR,j,2,Nlines2(i2)
            RightColor(j) = %White
            LeftColor(j) = %White
            i1 = i1 + 1
            i2 = i2 + 1
      End Select
   Next i
 
End Sub
 
'gbs_01138
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm