O algoritmo methapone

Um algoritmo fonético, como soundex otimizado somente para o idioma inglês

Existe uma descrição do algoritmo metaphone disponível nesta página. Também existe o algoritmo metaphone duplo, que também está implementado em C e com uma descrição no site ASpell.

Existe já uma implementação metaphone em delphi. Você pode encontrá-la em SourceForge. Essa versão é muito melhor do que esta.

O código está abaixo. Obti-o traduzindo a unidade de Metaphone.cc unidade do motor de busca htDig. Ele funciona bem em C, mas a tradução que fiz não é a melhor; porquê? Porque eu traduzi principalmente usando a abordagem C, e não a Delphi.

Gostaria também de incentivar a investigação em uma melhor (mais rápido e com menos códigos) tadução deste algoritmo, estou trabalhando em uma. Se acontecer de você ter uma tradução melhor, não hesite em postá-la.

NOTA: o algoritmo, bem como soundex estão somente em inglês de forma que não possuem nenhum código único de suporte, ou suporte para ñ, á, é, í e outros carateres diversos.

função MetaPhone3(const Word:String; KeyLength: Integer = 10): linha;

 função Mesma(x: Car): Boolean;
 começar
 Resultado := x in ['F','J','L','M','N','R'];
 final;

 função Vogal(x: Car): Boolean;
 começar
 Resultado := x in ['A','E','I','O','U'];
 final;

 função Varson(x: Car): Boolean;
 começar
 Resultado := x in ['C','G','P','S','T'];
 final;

 função Noghf(x: Car): Boolean;
 começar
 Resultado := x em ['B', 'D', 'H'];
 final;

 função FrontV(x: Char): Boolean;
 começar
 Resultado := x in ['E', 'I', 'Y']

  end;

  var
  i: Integer;
  Tmp:String;
  começar
  Tmp := Trim(UpperCase(Word));

  i := 1;
  enquanto (i > 0) do
  começar

  se (Tmp[i] em ['G', 'K', 'P']) e (Tmp[i+1] = 'N')
  ou ((Tmp[i] = 'A') e (Tmp[i+1] = 'E'))
  ou ((Tmp[i] = 'W') e (Tmp[i+1] = 'R')) e, em seguida, Apagar(Tmp, i, 1);
  if (Tmp[i] = 'W') e (Tmp[i+1] = 'H') e, em seguida

  Apagar(Tmp, 2, 1);


  se (Tmp[i] = 'X') então Tmp[i] := 'S';
  i := pos(' ', Tmp);
  se (i > 0) então Tmp[i] := #0;
  final;
  i := 0;
  Tmp := Tmp + #0;

  enquanto (Length(Resultado) < KeyLength) do
  começar
  inc(i);

  se (Tmp[i] =#0) então Break;
  se (Tmp[i] = Tmp[i-1]) e (Tmp[i] <> 'C') então
  Continuar;


  se Same(Tmp[i]) ou (Vowel(Tmp[i]) e (Tmp[i-1] = #0)) então
  começar
  Resultado := Resultado + Tmp[i];
  Continuar;
  final;

  caso Tmp[i] de

  'B': se ((i>=2) e (Tmp[i-1] <> 'M')) ou (i = 1) então Resultado := Resultado + Tmp[i];

  'C':

   começar
   se FrontV(Tmp[i+1]) e (Tmp[i-1] <> 'S') então
   começar
   Resultado := Resultadi + 'S';
   inc(i);
   e também se (Copy(Tmp, i, 2) = 'CH') ou (Copy (Tmp, i ,3) = 'CIA') então
   começar

  Resultado := Resultdo + 'X';

  se (Copy(Tmp, i, 2) = 'CH') então inc(i);

  se (Copy(Tmp, i, 3) = 'CIA')então inc(i, 2);

  final também Resultado := Resultado + 'K';

  final;


  'D': se (Copy(Tmp, i, 2) = 'DG') e FrontV(Tmp[i+3]) então

  começar

  inc(i,3);

  Resultado := Resultado + 'J';

  final também

  Resultado := Resultado + 'T';

  'G': se ((Tmp[i+1] <> 'G') ou Vowel(Tmp[i+1])) e

  ((Tmp[i+1]<>'N') ou ((Tmp[i+1] = #0) e (Tmp[i+2]<>'E')

   ou (Tmp[i+3] <>'D')) e ((Tmp[i+1] <> 'D') ou não FrontV(Tmp[i+1]))) então

   começar

   se (FrontV(Tmp[i+1])) e (Tmp[i+2] <> 'G') então

   Resultado := Resultado + 'J'

   ou

   Resultado := Resultado + 'K';

   final ou se (Tmp[i+1] = 'H') e não noghf(Tmp[i -3]) e (Tmp[i -4] <> 'H') então

   Resultado := Resultado + 'F';


   'H': se não Varson(Tmp[i-1]) e (not Vowel(Tmp[i-1]) ou Vowel(Tmp[i+1])) então

        Resultado:= Resultado + 'H';


   'K': se (Tmp[i-1] <> 'C') então Resultado:= Resultado + 'K';


   'P': se (Tmp[i+1] = 'H') então

   Resultado:= Resultado + 'F'

    ou Resultado:= Resultado + Tmp[i];

    
   'Q': Resultado:= Resultado + 'K';


    'S': se (Tmp[i+1] = 'H') ou ((Copy(Tmp, i, 2) = 'SI')

    e (Tmp[i+3] em ['O','A'])) então

    Resultado:= Resultado + 'X'

    ou

    Resultado:= Resultado + 'S';

     'T': se (Tmp[i+1] = 'I') e (Tmp[i+2] em ['O','A']) então

     Resultado:= Resultado + 'X'

     ou se (Tmp[i+1] = 'H') então Resultado:= Resultado + '0' ou

     se (Tmp[i+1] <> 'C') ou (Tmp[i+2] <> 'H') então Resultado:= Resultado + 'T';


     'V': Resultado:= Resultado + 'F';


     'W','Y': se Vogal(Tmp[i+1]) então Resultado:= Resultado + Tmp[i];


     'X': Resultado:= Resultado + 'KS';


     'Z': Resultado:= Resultado + 'S';

    final;

    final;

    final;