Looking for a Fuzzy Matching algorithm

[Hans List]

Hi All,

I'm looking for a Fuzzy Matching algorithm to compare two
sentences, compute the percentage of matching and show the
difference(s).

But I don't have any clue at all on how to program such an
algorithm in VBA.

E.g. I'd like to match these sentences:

(1) Turn the bolt clockwise.
(2) Turn the red bolt clockwise.

Matching: 89%
The word 'red' in the second sentence is marked different.
(e.g. by color).

Thank you very much for pointing me in the right direction!

Hans List

 

[Hans List]

Why do I get an error in the line with Redim?

Hans List


Public strFirst As String
Public strSecond As String

Sub CalculateFuzzyMatch()

strFirst = "International"
strSecond = "Interesting"

Dim dist As Integer
dist = LD(strFirst, strSecond)
MsgBox Str(dist)

End Sub

Private Function Minimum(ByVal a As Integer, _
ByVal b As Integer, _
ByVal c As Integer) As Integer
Dim mi As Integer

mi = a

If b < mi Then
mi = b
End If

If c < mi Then
mi = c
End If

Minimum = mi

End Function
Public Function LD(ByVal s As String, ByVal t As String) As
Integer
'*** Compute Levenshtein Distance
Dim d(1 To 2, 1 To 2) As Integer ' matrix
Dim m As Integer ' length of t
Dim n As Integer ' length of s
Dim i As Integer ' iterates through s
Dim j As Integer ' iterates through t
Dim s_i As String ' ith character of s
Dim t_j As String ' jth character of t
Dim cost As Integer ' cost

' Step 1

n = Len(strFirst)
m = Len(strSecond)

If n = 0 Then
LD = m
Exit Function
End If

If m = 0 Then
LD = n
Exit Function
End If

ReDim d(0 To n, 0 To m) As Integer

' Step 2

For i = 0 To n
d(i, 0) = i
Next i

For j = 0 To m
d(0, j) = j
Next j

' Step 3

For i = 1 To n

s_i = Mid$(s, i, 1)

' Step 4

For j = 1 To m

t_j = Mid$(t, j, 1)

' Step 5

If s_i = t_j Then
cost = 0
Else
cost = 1
End If

' Step 6

d(i, j) = Minimum(d(i - 1, j) + 1, d(i, j - 1)
+ 1, d(i - 1, j - 1) + cost)

Next j

Next i

' Step 7

LD = d(n, m)



End Function

 

[Perry]

You have already typed the array with

Dim d(1 To 2, 1 To 2) As Integer ' matrix

Following statement will suffice:

Redim d(0 To n, 0 to m)

Krgrds,
Perry

 

[Hans List]

You have already typed the array with

Following statement will suffice:

Redim d(0 To n, 0 to m)

Hi Perry,

Sorry, but the macro still stops at the Redim line (even
with Option Base set explicitely to 0 or 1).

Regards,

Hans

 

[Jonathan West]

Hi Perry,

Sorry, but the macro still stops at the Redim line (even with Option Base
set explicitely to 0 or 1).

Try changing this line

Dim d(1 To 2, 1 To 2) As Integer ' matrix

to these two lines

Dim d() As Integer ' matrix
ReDim d(1 To 2, 1 To 2)

Also, generally you get better performance if you define variables as Long
rather than as Integer. That is because a Long fits the 32-bit architecture
of most modern CPUs.


--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org

 

[Perry]

A multidimensional dynamic arrays ...
ahhhh
If you don't need to pre-allocation of the array, leave it blank
like in:

Dim d() As Integer ' matrix
'rest of yr code (incl. validating n and m)

'Re-allocate yr array using
No Option base clause needed here.

Krgrds,
Perry

 

[Hans List]

A multidimensional dynamic arrays ...
ahhhh
If you don't need to pre-allocation of the array, leave it blank
like in:

Dim d() As Integer ' matrix
'rest of yr code (incl. validating n and m)

'Re-allocate yr array using

Jonathan, Perry,

Thank you very much!

Hans