Викиучебник

Реализации алгоритмов/Расстояние Левенштейна: различия между версиями

Интерактивная навигация по истории
← Предыдущая правкаСледующая правка →
Содержимое удалено Содержимое добавлено
ВизуальныйВики-текст
Строка 5:
<source lang="vb">
 
Public Function LevenshteinDistancelevenshtein(s1ByVal string1 As String, s2ByVal string2 As String) As Long▼
Option Base 0
 
Dim i As Long, j As Long, bs1() As Byte, bs2() As Byte
▲Public Function LevenshteinDistance(s1 As String, s2 As String) As Long
Dim l1string1_length As Long: l1 = VBA.Len(s1) + 1
Dim l2string2_length As Long: l2 = VBA.Len(s2) + 1
Dim idistance() As Long▼
Dim min1 As Long, min2 As Long, min3 As Long
 
string1_length = Len(string1)
If l1 = 1 Then Err.Raise 449
string2_length = Len(string2)
If l2 = 1 Then Err.Raise 449
ReDim distance(string1_length, string2_length)
bs1 = string1
bs2 = string2
 
For i Dim= diff0 AsTo Bytestring1_length
Dim m distance(i, 0) As= Longi
Next▼
▲ Dim i As Long
ReDim m(l1, l2)
Dim b1() As Byte: b1 = VBA.StrConv(s1, VBA.VbStrConv.vbUnicode)
Dim b2() As Byte: b2 = VBA.StrConv(s2, VBA.VbStrConv.vbUnicode)
 
For ij = 0 To l1string2_length
mdistance(i0, 1j) = ij
Next
 
For ji = 01 To l2string1_length
For j = m(1, j)To = jstring2_length
'slow way: If Mid$(string1, i, 1) = Mid$(string2, j, 1) Then
▲ Next
If bs1((i - 1) * 2) = bs2((j - 1) * 2) Then ' *2 because Unicode every 2nd byte is 0
m(i, j) = Min(mdistance(i - 1, j) + 1,= m(i, j - 1) + 1, mdistance(i - 1, j - 1) + diff)▼
Next Else▼
'distance(i, j) = Application.WorksheetFunction.Min _
(distance(i - 1, j) + 1, _
distance(i, j - 1) + 1, _
distance(i - 1, j - 1) + 1)
' spell it out, 50 times faster than worksheetfunction.min
min1 = distance(i - 1, j) + 1
min2 = distance(i, j - 1) + 1
min3 = distance(i - 1, j - 1) + 1
If min1 <= min2 And min1 <= min3 Then
distance(i, j) = min1
ElseIf min2 <= min1 And min2 <= min3 Then
distance(i, j) = min2
Else
distance(i, j) = min3
End If
 
For i = 1 To l1 End If
For j = 1 To l2Next
Next▼
If b1(i - 1) = b2(j - 1) Then diff = 0 Else diff = 1
▲ m(i, j) = Min(m(i - 1, j) + 1, m(i, j - 1) + 1, m(i - 1, j - 1) + diff)
▲ Next
▲ Next
 
levenshtein = distance(string1_length, string2_length)
LevenshteinDistance = m(l1, l2) - 1
 
End Function
 
' Вспомогательная функция
Function Min(v1 As Integer, v2 As Integer, v3 As Integer) As Integer
Min = IIf(v1 < v2, v1, v2)
If Min > v3 Then Min = v3
End Function
 
' Пример использования
MsgBox LevenshteinDistancelevenstein("папа", "мама")
 
</source>
Источник — https://ru.wikibooks.org/wiki/Реализации_алгоритмов/Расстояние_Левенштейна