Author: Tomas Rutkauskas
Soundex function
Answer:
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!!!
1
2 function Soundex(S: string): string;
3 const
4 CvTable: array['B'..'Z'] of char = (
5 '1', '2', '3', '0', '1', {'B' .. 'F'}
6 '2', '0', '0', '2', '2', {'G' .. 'K'}
7 '4', '5', '5', '0', '1', {'L' .. 'P'}
8 '2', '6', '2', '3', '0', {'Q' .. 'U'}
9 '1', '0', '2', '0', '2'); {'V' .. 'Z'}
10 var
11 i, j: Integer;
12 aGroup, Ch: Char;
13
14 function Group(Ch: Char): Char;
15 begin
16 if (Ch in ['B'..'Z']) and not (Ch in ['E', 'H', 'I', 'O', 'U', 'W', 'Y']) then
17 Result := CvTable[Ch]
18 else
19 Result := '0';
20 end;
21
22 begin
23 Result := '000';
24 if S = '' then
25 exit;
26
27 S := Uppercase(S);
28 i := 2;
29 j := 1;
30 while (i <= Length(S)) and (j <= 3) do
31 begin
32 Ch := S[i];
33 aGroup := Group(Ch);
34 if (aGroup <> '0') and (Ch <> S[i - 1]) and
35 ((J = 1) or (aGroup <> Result[j - 1])) and
36 ((i > 2) or (aGroup <> Group(S[1]))) then
37 begin
38 Result[j] := aGroup;
39 Inc(j);
40 end;
41 Inc(i);
42 end; {while}
43
44 Result := S[1] + '-' + Result;
45 end;
Solve 2:
46
47 function StrSoundEx(const OrgString: string): string;
48 var
49 s: string;
50 PrevCh: char;
51 Ch: char;
52 i: integer;
53 begin
54 s := UpperCase(Trim(OrgString));
55 if s <> '' then
56 begin
57 PrevCh := #0;
58 result := s[1];
59 for i := 2 to Length(s) do
60 begin
61 if Length(result) = 4 then
62 break;
63 Ch := s[i];
64 if (Ch <> PrevCh) then
65 begin
66 if Ch in ['B', 'P', 'F', 'V'] then
67 result := result + '1'
68 else if Ch in ['C', 'S', 'K', 'G', 'J', 'Q', 'X', 'Z'] then
69 result := result + '2'
70 else if Ch in ['D', 'T'] then
71 result := result + '3'
72 else if Ch in ['L'] then
73 result := result + '4'
74 else if Ch in ['M', 'N'] then
75 result := result + '5'
76 else if Ch in ['R'] then
77 result := result + '6';
78 PrevCh := Ch;
79 end;
80 end;
81 end;
82 while Length(result) < 4 do
83 result := result + '0';
84 end;
|
