Mega Code Archive
Use Soundex to find phonetically similar names
<![CDATA[
Title: Use Soundex to find phonetically similar names
Question: Implements a function for calculating the Soundex of a string. Can be used to implement text searches (e.g. - names) for strings that are phonetically similar, based on U.S. Census Bureau Soundex standard.
Answer:
function Soundex(in_str: String): String;
// The string for which the soundex should be calculated is
// passed via the in_str argument. Function returns the
// resulting soundex.
// The Soundex algorithm is based on an article by Rod Stephens
// in the March, 1998 issue of Delphi Informant magazine.
var
no_vowels, coded, out_str: String;
ch: Char;
ii: Integer;
begin
in_str := Trim(UpperCase(in_str));
if Length(in_str) 0 then begin
no_vowels := in_str[1];
for ii := 2 to Length(in_str) do begin
ch := in_str[ii];
case ch of
'A','E','I','O','U',' ','H','W','Y': ; //do nothing
else
no_vowels := no_vowels + ch;
end;
end;
coded := '';
for ii := 1 to Length(no_vowels) do begin
ch := no_vowels[ii];
case ch of
'B','F','P','V': ch := '1';
'C','G','J','K','Q','S','X','Z': ch := '2';
'D','T': ch := '3';
'L': ch := '4';
'M','N': ch := '5';
'R': ch := '6';
else
ch := '0';
end;
coded := coded + ch;
end;
out_str := no_vowels[1];
for ii := 2 to Length(no_vowels) do begin
if (coded[ii] coded[ii-1]) then begin
out_str := out_str + coded[ii];
if (Length(out_str) = 4) then
break;
end;
end;
Soundex := out_str;
end else
Soundex := '';
end;
]]>