## 2003. december 19., péntek

### Soundex function

Problem/Question/Abstract:

Soundex function

Solve 1:

This function will scan a string, and return a 'soundex' value. Comparing soundex values will give an indication of 'how alike' two strings sound... Play with it and see!!!

function Soundex(S: string): string;
const
CvTable: array['B'..'Z'] of char = (
'1', '2', '3', '0', '1', {'B' .. 'F'}
'2', '0', '0', '2', '2', {'G' .. 'K'}
'4', '5', '5', '0', '1', {'L' .. 'P'}
'2', '6', '2', '3', '0', {'Q' .. 'U'}
'1', '0', '2', '0', '2'); {'V' .. 'Z'}
var
i, j: Integer;
aGroup, Ch: Char;

function Group(Ch: Char): Char;
begin
if (Ch in ['B'..'Z']) and not (Ch in ['E', 'H', 'I', 'O', 'U', 'W', 'Y']) then
Result := CvTable[Ch]
else
Result := '0';
end;

begin
Result := '000';
if S = '' then
exit;

S := Uppercase(S);
i := 2;
j := 1;
while (i <= Length(S)) and (j <= 3) do
begin
Ch := S[i];
aGroup := Group(Ch);
if (aGroup <> '0') and (Ch <> S[i - 1]) and
((J = 1) or (aGroup <> Result[j - 1])) and
((i > 2) or (aGroup <> Group(S[1]))) then
begin
Result[j] := aGroup;
Inc(j);
end;
Inc(i);
end; {while}

Result := S[1] + '-' + Result;
end;

Solve 2:

function StrSoundEx(const OrgString: string): string;
var
s: string;
PrevCh: char;
Ch: char;
i: integer;
begin
s := UpperCase(Trim(OrgString));
if s <> '' then
begin
PrevCh := #0;
result := s[1];
for i := 2 to Length(s) do
begin
if Length(result) = 4 then
break;
Ch := s[i];
if (Ch <> PrevCh) then
begin
if Ch in ['B', 'P', 'F', 'V'] then
result := result + '1'
else if Ch in ['C', 'S', 'K', 'G', 'J', 'Q', 'X', 'Z'] then
result := result + '2'
else if Ch in ['D', 'T'] then
result := result + '3'
else if Ch in ['L'] then
result := result + '4'
else if Ch in ['M', 'N'] then
result := result + '5'
else if Ch in ['R'] then
result := result + '6';
PrevCh := Ch;
end;
end;
end;
while Length(result) < 4 do
result := result + '0';
end;