Soundex function

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;