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