' Вычисление расстояния Левенштейна между 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