Реализация алгоритма фонетического сравнения Soundex

* Реализация алгоритма soundex (фонетического сравнения слов английского языка).
* Код для SPSS: Simon Freidin, 2003
* *** Начало алгоритма ***
* (См. описание: http://www.fearme.com/misc/alg/node128.html, автор: Scott Gasch, раздел 0.5.10)

* M. K. Odell и R. C. Russell запатентовали систему Soundex для фонетического сравнения
  в 1918 и 1922 гг.
* Кодировщик Soundex сопоставляет разбираемому английскому слову четырёхсимвольный код,
  соответствующий фонетическому звучанию данного слова. Обычно такая система используется
  для осуществления "нечёткого" поиска, когда требуется найти похожие по звучанию
  слова. Например, для поиска возможных правильных альтернатив для слова, написанного 
  с ошибкой, некоторые программы грамматической проверки генерируют для ошибочно
  написанного слова код Soundex, а затем предлагают для замены слова, имеющие
  тот же код Soundex.
* Кроме того, кодирование Soundex часто используется для поиска в базах данных
  сложнопроизносимых фамилий.
* Создание кода Soundex - довольно простая операция.
* Во-первых, удаляем из строки все неанглийские буквы и символы.
* В случае гласных с ударениями просто убираем ударения, убираем тире, пробелы и т.д.
* Кроме этого, убираем все буквы H и W, если только они не стоят в начале слова.
* Теперь берём первую букву слова и делаем её первым элементом кода Soundex.
* Каждую следующую букву в слове переводим в цифровой код по схеме, представленной ниже,
  учитывая порядок следования букв.
*
*           A, E, I, O, U, Y = 0
*                 B, F, P, V = 1
*     C, G, J, K, Q, S, X, Z = 2
*                       D, T = 3
*                          L = 4
*                       M, N = 5
*                          R = 6
*
* Теперь возможные идущие подряд дубликаты кодов заменяем одним.
* Удаляем первую цифру кода в том случае, если она соответствует букве, стоящей
  в начале. Удаляем все нули. Затем усекаем получившуюся строку до 4 символов.
  Если же её длина меньше 4 символов, заполняем оставшуюся длину строки нулями.

* (ссылки на попытки адаптации системы Soundex и ей подобных к русскому языку можно найти
  в статье Википедии: http://ru.wikipedia.org/wiki/Soundex )- примеч. перев.

* ****  Конец алгоритма *****

set printback=listing.
data list list/name (a20).
begin data.
Oconnell
smythe
smith
end data.
/* переводим в верхний регистр и удаляем пробелы с краёв строки */
compute name=ltrim(rtrim(upcase(name))).
string a1 to a20 (a1) soundex1 (a20).
* разбиваем имена на символы, сделаем первую букву каждого имени - 
  первой буквой кода soundex .
do repeat a=a1 to a20/b=1 to 20.
compute a=substr(name,b,1).
end repeat.
compute soundex1=a1.
recode a1 to a20  ('A', 'E', 'I', 'O', 'U', 'Y' = '0')('B', 'F', 'P', 'V' =
'1')
  ('C', 'G', 'J', 'K', 'Q', 'S', 'X', 'Z' = '2')
  ('D', 'T' = '3')('L' = '4')('M', 'N' = '5')('R' = '6')(else='').
* добавляем цифры к коду soundex .
* (опуская пробелы, буквы H, W и неалфавитные символы,
  ранее перекодированные в '') .
do repeat a=a2 to a20.
if a ~= '' soundex1=concat(ltrim(rtrim(soundex1)),a).
end repeat.
execute.
* теперь превратим продублированные цифры в одну.
string pl cl (a1) soundex2 (a20).
loop x=1 to 20.
compute cl=substr(soundex1,x,1).
if cl ~= pl soundex2=concat(ltrim(rtrim(soundex2)),cl).
compute pl=cl.
end loop.

* далее, если первая цифра из строки кода Soundex совпадает с кодом первой буквы, 
  удалим эту цифру.
string soundex3 (a20).
compute soundex3=soundex2.
if a1=substr(soundex2,2,1)
soundex3=concat(substr(soundex2,1,1),substr(soundex2,3)).

* теперь исключим нули из строки кода Soundex.
string soundex4 (a20).
loop x=1 to 20.
compute cl=substr(soundex3,x,1).
if cl ~= '0' soundex4=concat(ltrim(rtrim(soundex4)),cl).
end loop.

* наконец, возвращаем первые 4 символа из образовавшейся строки в качестве
  кода Soundex.
* если в коде меньше 4 символов, расширим его до 4-х, добавив в конец
  соответствующее число нулей.
string soundex (a4).
compute soundex=soundex4.
if length(ltrim(rtrim(soundex)))=3 soundex=concat(ltrim(rtrim(soundex)),'0').
if length(ltrim(rtrim(soundex)))=2 soundex=concat(ltrim(rtrim(soundex)),'00').
if length(ltrim(rtrim(soundex)))=1 soundex=concat(ltrim(rtrim(soundex)),'000').
execute.
match files file=*/keep=name soundex.
execute.