Soundex function (Views: 27)
Problem/Question/Abstract: 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!!! 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; |