Расстояние Левенштейна между двумя строками

 

Загрузить как .sbs Показать простым текстом

 

См. пример синтаксиса, вызывающего этот скрипт, чтобы понять, как должны быть организованы данные перед вызовом,  и т.д.: Levenshtein distance between 2 strings (syntax)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
' Вычисление расстояния Левенштейна между 2 строками.
' (см. http://www.merriampark.com/ld.htm#ALGORITHM)
' Итосчник использованных здесь двух функций - url, приведённый выше.
' Процедура Main написана Рейналем Левек, 04.02.2004.

'См. также информацию на русском языке: http://ru.wikipedia.org/w/index.php?title=Расстояние_Левенштейна

' Для использования этого скрипта редактор данных SPSS должен содержать 2 строковых переменных s1 и s2
'(расположенных по соседству).
' Для каждого наблюдения скрипт вычисляет расстояние между двумя строками s1 и s2 и записывает результат
'в текстовый файл.
' Пример контекста использования этого скрипта вы найдёте в файле синтаксиса "LevinshteinDistanceBetween2strings.SPS".

Sub Main

	Dim objDocuments As ISpssDocuments
    Dim objDataDoc As ISpssDataDoc
	Dim strCmd As String
	Dim lngNbCases As Long

    Set objDocuments=objSpssApp.Documents
    Set objDataDoc = objDocuments.GetDataDoc(0)
	'В этот файл мы запишем расстояния
	Open "C:\\temp\\distances.txt" For Output As #1

    ' Получим данные из переменных s1 и s2
    Dim SpssTextData As Variant
	lngNbCases = objDataDoc.GetNumberOfCases
    SpssTextData = objDataDoc.GetTextData ("s1", "s2", 1, lngNbCases)

	Dim d As Integer
	Dim intCnt As Long
	For intCnt = 0 To lngNbCases - 1
		d=LD(SpssTextData(0,intCnt),SpssTextData(1,intCnt))
		'MsgBox("Расстояние равно " & d )
		Print #1, d
	Next
	Close #1

	Set objDataDoc = Nothing
	Set objDocuments = Nothing
End Sub



'********************************
'*** Вычисление расстояния Левенштейна
'(источник: http://www.merriampark.com/ld.htm#ALGORITHM)
'********************************

Public Function LD(ByVal s As String, ByVal t As String) As Integer
	Dim d() As Integer ' матрица
	Dim m As Integer ' длина строки целевой строки t
	Dim n As Integer ' длина строки-источника s
	Dim i As Integer ' счётчик цикла для пробегания по s
	Dim j As Integer ' счётчик цикла для пробегания по t
	Dim s_i As String ' i-й символ s
	Dim t_j As String ' j-й символ t
	Dim cost As Integer ' штраф (cost)

  ' Шаг 1

  n = Len(s)
  m = Len(t)
  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

  ' Шаг 2
  For i = 0 To n
    d(i, 0) = i
  Next i
  For j = 0 To m
    d(0, j) = j
  Next j

  ' Шаг 3
  For i = 1 To n
    s_i = Mid$(s, i, 1)
    ' Шаг 4
    For j = 1 To m
      t_j = Mid$(t, j, 1)
      ' Шаг 5
      If s_i = t_j Then
        cost = 0
      Else
        cost = 1
      End If
      ' Шаг 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

  ' Шаг 7

  LD = d(n, m)
  Erase d

End Function

'*******************************
'*** Поиск минимума из 3 значений
'(источник: http://www.merriampark.com/ld.htm#ALGORITHM)
'*******************************

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
Related pages

...

Navigate from here