Soundex em português!!

Delphi

27/03/2005

Caros colegas
Fiz um sistema de cadastro de pacientes para um setor de hospital e precisava que a ficha dos pacientes fossem recuperadas pelo nome independentemente das muitas grafias com que podem ser escritos. Exemplo: Tereza, Theresa, etc.
Durante muito tempo procurei um rotina que convertesse uma palavra para os fonemas que a compõe, e sempre fui remetido ao Soundex que funciona para o idioma inglês, mas não para o nosso português.
Em minhas andanças pela net achei a tese de mestrado “Desenvolvimento de Sistema para Conversão de Textos em Fonemas no Idioma Português”, de Dimas Trevizan Chbane (neste [url=http://regulus.pcs.usp.br/~geraldo/textos/disdimas.pdf]endereço[/url], o trabalho é extenso e permitiria até fazer um sistema de fala e de separação de sílabas.) e com base nele fiz uma rotina que devolve os fonemas.
Agora, gostaria que vocês analisassem a rotina e fizessem sugestões visando a melhoria.

Vejam alguns resultados
[list:47c3a064a7]
ANDREA andRea
ANDREIA andRea
ELENAelena
HELENAelena
ELIZABETE elizabete
ELIZABETH elizabete
ELISABETE elizabete
INACIOesxetian
IGNACIOinasiu
GIZELLE jizele
GIZELEjizele
GISELLE jizele
GISELEjizele
GISELI jizeli
GISELLI jizeli
KELY keli
QUELI keli
KELLY keli
KELLI keli
KELI keli
CRISTINA kRistina
CRISTINAkristina
LOPEZlopes
LOPESlopes
MARTAmaRta
MARTHA maRta
OSVALDOosvaudu
OSWALDOosvaudu
RUTErute
RUTHrute
SIDNEYsidinei
SYDNEYsidinei
SIDNEIsidinei
SYDNEIsidinei
CYDNEIsidinei
CYDNEYsidinei
CIDNEIsidinei
SYLVIA siuvia
SILVIA siuvia
TERESA teReza
THEREZAteReza
THERESAteReza
TEREZA teReza
WALKIRIA vaukiRia
WALQUIRIA vaukiRia
VALQUIRIAvaukiRia
CHEILAxeila
SHEILAxeila
[/list:u:47c3a064a7]


function SomDex (strNome : string) : string;
var
  V, V1 : set of Char;
  C, CN : set of ´a´..´z´;

  intTam, n : integer;

begin
  V := [´a´, ´e´, ´i´, ´o´, ´u´, ´y´, ´á´,´é´, ´ê´, ´ó´, ´ô´, ´í´, ´ú´, ´â´, ´à´, ´ä´, ´è´, ´ë´, ´ì´, ´ï´, ´î´, ´ò´, ´ö´, ´ü´, ´ù´, ´û´];
  V1 := [´e´, ´i´, ´y´,´é´, ´ê´, ´í´, ´è´, ´ë´, ´ì´, ´ï´, ´î´, ´ù´, ´û´];
  C := [´b´, ´c´, ´d´, ´f´, ´g´, ´h´, ´j´, ´k´, ´l´, ´m´, ´n´, ´p´, ´q´, ´r´, ´s´, ´t´, ´v´, ´w´, ´x´, ´z´];
  CN := [´m´, ´n´];

  {Result := Excecoes.Values[Trim(strNome)];
  if Result <> ´´ then exit;}
  Result := ´´;
  strNome := ´´ + AnsiLowerCase(Trim(strNome)) + ´´;
  intTam := length(strNome);
  n := 1;
  while n < intTam do
  begin
    inc(n);
    if (strNome[n] = strNome[n + 1]) then
       inc(n);
       
    case strNome[n] of
       ´´ :
           exit;
       ´a´, ´á´, ´â´, ´à´, ´ä´ :
           Result := Result + ´a´;
       ´e´, ´è´, ´ë´ :
           begin
             if (strNome[n + 1]= ´´) or (Copy(strNome, n+1, 2) = ´s´) then
                Result := Result + ´e´
                //Result := Result + ´i´
             else
                Result := Result + ´e´;
           end;
       ´é´, ´ê´ :
           Result := Result + ´e´;
       ´i´, ´y´, ´í´, ´ì´, ´ï´, ´î´ :
             if not ((strNome[n - 1] in [´e´, ´é´]) and (strNome[n + 1] in [´a´, ´o´])) then
                Result := Result + ´i´;
       ´o´, ´ò´, ´ö´ :
           begin
             if (strNome[n+1] = ´´) or (Copy(strNome, n+1, 2) = ´s´) then
                Result := Result + ´u´
             else
                Result := Result + ´o´;
           end;
       ´ó´, ´ô´ :
           begin
             if (strNome[n+1] = ´´) then
                Result := Result + ´o´
             else
                Result := Result + ´o´;
           end;
       ´u´, ´ú´, ´ü´, ´ù´, ´û´ :
           Result := Result + ´u´;
       ´b´, ´f´, ´j´, ´k´, ´v´  :
           Result := Result + strNome[n];
       ´c´ :
           begin
             if (strNome[n+1] in V1) then
                Result := Result + ´s´
             else if (strNome[n+1] in [´a´, ´o´, ´u´, ´r´, ´l´]) then
                Result := Result + ´k´
             else if (Copy(strNome, n + 1, 2) = ´hr´) then  //christina, chrizóstemo
               begin
                  Result := Result + ´kR´;
                  n := n + 2;
               end
             else if (strNome[n+1] = ´h´) then
               begin
                  Result := Result + ´x´;
                  inc(n);
               end
             else if (strNome[n+1] = ´k´) then
               begin
                  Result := Result + ´k´;
                  inc(n);
               end
             else
                Result := Result + ´k´;
           end;
       ´d´ :
           begin
             if (strNome[n+1] in C) and (not (strNome[n+1] in [´r´, ´l´])) or (strNome[n+1] = ´´) then
                Result := Result + ´di´
             else
                Result := Result + ´d´;
           end;
       ´g´ :
           begin
             if (Copy(strNome, n + 1, 2) = ´ue´) or (Copy(strNome, n + 1, 2) = ´ui´) or(strNome[n+1] = ´ü´) then
               begin
                 Result := Result + ´g´;
                 inc(n);
               end
             else if (strNome[n+1] in [´i´, ´e´]) then
                Result := Result + ´j´
             else if (Copy(strNome, n - 2, 2) = ´i´) and (strNome[n + 1] = ´n´) then
               begin
                 Result := Result + ´n´;
                 inc(n);
               end
             else
               Result := Result + ´g´;
           end;
       ´h´ :
           n := n;
       ´l´ :
           begin
             if (strNome[n+1] = ´h´) then
               begin
                 Result := Result + ´L´;
                 inc(n);
               end
             else if (strNome[n+1] = ´´) then
                Result := Result + ´u´
             else if (strNome[n+1] in C) then
                Result := Result + ´u´
             else
                Result := Result + ´l´
           end;
       ´m´ :
           begin
             if (strNome[n-1] in V) and  (strNome[n+1] in C) or (strNome[n+1] = ´´) then
                Result := Result + ´n´
             else
                Result := Result + ´m´;
           end;
       ´n´ :
           begin
             if (strNome[n+1] = ´h´) then
               begin
                 Result := Result + ´N´;
                 inc(n);
               end
             else
                Result := Result + ´n´
           end;
       ´p´ :
           begin
             if (strNome[n+1] = ´h´) then
               begin
                 Result := Result + ´f´;
                 inc(n);
               end
             else
                Result := Result + ´p´;
           end;
       ´q´ :
           begin
             if (Copy(strNome, n + 1, 2) = ´ue´) or (Copy(strNome, n + 1, 2) = ´ui´) then
               begin
                 Result := Result + ´k´;
                 inc(n);
               end
             else
                 Result := Result + ´k´;
           end;
       ´r´ :
           begin
             if (strNome[n-1] in  [´´, ´n´, ´m´, ´r´]) then
                Result := Result + ´r´
             else
                Result := Result + ´R´
           end;
       ´s´ :
           begin
             if (strNome[n+1] = ´h´) then
               begin
                  Result := Result + ´x´;
                  inc(n);
               end
             else if (strNome[n-1] = ´´) and (strNome[n+1] in V) then
                 Result := Result + ´s´
             else if (strNome[n-1] = ´´) and (strNome[n+1] in C) then
                 Result := Result + ´es´
             else if (Copy(strNome, n + 1, 2) = ´ce´) or (Copy(strNome, n + 1, 2) = ´ci´) or (strNome[n+1] = ´ç´) then
               begin
                  Result := Result + ´s´;
                  inc(n);
               end
             else if (strNome[n-1] in V) and (strNome[n+1] in V) then
                  Result := Result + ´z´
             else if (strNome[n-1] in V) and (strNome[n+1] in C) then
                  Result := Result + ´s´
             else if (Copy(strNome, 1, 3) = ´ex´) and (strNome[n-1] in V) then
                 Result := Result + ´z´
             else if (strNome[n-1] in C) and  (strNome[n+1] in V) then
                  Result := Result + ´s´
             else
                Result := Result + ´s´;
           end;
       ´t´ :
           begin
             if (Copy(strNome, n + 1, 2) = ´h#´) then
                Result := Result + ´te´
             else if (strNome[n+1] <> ´´) then
                Result := Result + ´t´;
           end;
       ´w´ :
           begin
             if (Copy(strNome, n + 1, 2) = ´al´) or (Copy(strNome, n + 1, 2) = ´an´) then
                Result := Result + ´v´
             else
                Result := Result + ´u´;
           end;
       ´x´ :
           begin
             if (strNome[n-1] = ´´) or (strNome[n-1] = ´n´) then
                 Result := Result + ´x´
             else if (Copy(strNome, n+1, 2) = ´ce´) or (Copy(strNome, n+1, 2) = ´ci´) then
               begin
                 Result := Result + ´s´;
                 inc(n);
               end
             else if (strNome[n-1] in V) and (strNome[n+1] = ´t´) then
                 Result := Result + ´s´
             else if (Copy(strNome, n+1, 2) = ´ai´) or (Copy(strNome, n+1, 2) = ´ei´) or (Copy(strNome, n+1, 2) = ´ou´) then
                 Result := Result + ´x´
             else if (Copy(strNome, n- 2, 2) = ´e´) and  (strNome[n+1] in V) then
                 Result := Result + ´z´
             else
                 Result := Result + ´x´
           end;
       ´z´ :
           begin
             if (strNome[n-1] = ´´) then
                 Result := Result + ´z´
             else if (strNome[n+1] = ´´) or (strNome[n+1] in C) then
                 Result := Result + ´s´
             else
                  Result := Result + ´z´
           end;
       ´ç´ :
           Result := Result + ´s´;
       ´ã´ :
                Result := Result + ´ã´;
       ´õ´ :
           Result := Result + ´õ´;
        ´´´´ : inc(n);
       else
          Result := Result + ´@´;
    end;
  end;
end;


Lógico que existem limitações e gostaria que opinassem dessem sugestões:
1 - A rotina foi feita funciona com o portugûes portanto pode falhar com nomes estrangeiros como Washington, William, Rachel, etc. largamente utilizados. Mas resolvi isso com um dicionário (está comentado no código, já que não é o principal aqui) Fiz algumas adaptações como converter ´sh´ por ´x´ embora ´sh´ não faça parte do português.
2 - Gostaria que os nomes terminados em ´e´ e ´i´ retornassem com a mesma letra no final Gergete, Gerogeti = georgeti, mas isso causa problemas como outros nomes como Jose (sem acento) que viria como josi. Os que terminam com ´o´ vem com ´u´. Augusto, Augustu = augustu
3 - O ´s´ no final é eliminado. Marcos, Marco, Marcus = marcu

Abaixo transcrevo as regras publicadas na tese sobre como conversão de palvras em seus fonemas:
´Arquivo REGRAS.CON
Para a descrição das regras do arquivo REGRAS.CON foram utilizados
alguns caracteres especiais com a finalidade de simplificar as regras a serem
aplicadas. Assim, o símbolo # serve como delimitador de palavras; o símbolo $
como indicador de qualquer uma das vogais; o símbolo * como indicador de
qualquer uma das consoantes e o símbolo ¬ como indicador das consoantes nasais
(m ou n).
As linha iniciadas por ponto-e-vírgula (;) são consideradas comentários, e
linhas em branco não são consideradas. Para cada letra deve existir um conjunto de
regras separadas por barra (/), no seguinte formato:
/letra, fone_default, incremento
regra 1
...
regra n
/
sendo que:
- letra corresponde a letra a ser convertida;
- fone_default é o fonema que deve ser substituido caso o contexto não se encaixe
em nenhuma das regras descritas abaixo, e
- incremento é a quantidade que deve ser adicionada ao indexador de letras da
palavra. Quando incremento = 1, significa que se deve analisar a
próxima letra da palavra; incremento = 2, significa que se deve
´pular´ a próxima letra e considerar a seguinte.
No caso da letra ´b´, por exemplo, não há regras especiais de conversão,
tornando essa definição como simplesmente:
/b,b,1
/
Caso haja alguma regra de conversão, sua especificação deve ser feita após a
primeira linha contendo barra (/), no seguinte formato:
carac_anterior, carac_posterior, fone, incremento, tônica
onde:
- carac_anterior são os caracteres (ou caracter) que precedem a letra considerada;
- carac_posterior são os caracteres (ou caracter) que sucedem a letra
considerada;
- fone é transcrição fonológica, constituida por apenas um caracter, a ser aplicada
caso os caracteres que precedem e sucedem a letra sejam os mesmos de
carac-anterior e carac_posterior;
- incremento é definido de maneira análoga à do fone_default, e
- tônica indica a necessidade da aplicação da regra, no caso de letra pertencente à
silaba tônica.
Para a letra ´c´, por exemplo, essas regras seriam:
/c,k,1
,e,s,1,
,i,s,1,
,a,k,1,
,o,k,1,
,u,k,1,
,h,x,2,
/

Neste caso não há contexto anterior à letra ´c´. Havendo as letras ´e´ ou ´i´
após a letra ´c´´, sua transcrição corresponderá à /s/; caso seja seguida por ´a´, ´o´ ou
´u´, a transcrição corresponderá à /k/, e se for seguida por ´h´, será transcrita para
/x/, e a letra ´h´ será ´pulada´ (incremento = 2). Não há exigências para que essas
letras façam parte da sílaba tônica, em nenhuma dessas regras.
Para a letra ´a´, a terceira regra indicada abaixo apenas deverá ser aplicada
quando esta letra pertencer à sílaba tônica:
/a,a,1
,¬*,ã,2,
,¬#,Ã,2,
,¬,ã,2,t
/
Conforme essa regra, o ´a´ seguido de consoante nasal deve ser transcrito
para /ã/ quando pertencer à sílaba tônica. Deverá igualmente ser transcrito para /ã/
quando seguido de consoante nasal e depois por consoante (1 a . regra), e para /Ã/,
representando /ãu/, quando seguido por consoante nasal em final de palavra (2 a .
regra).
As demais regras utilizadas estão descritas no Anexo A, utilizando-se o
alfabéto fonético de um caracter apresentado na Tabela 2.1, com os seguintes
caracteres adicionais:
- a letra ´E´, para designar o encontro vocálico ´ei´ que ocorre em palavras
terminadas por ´em´, como na palavra sem (/seim/), transcrita como /sEm/.
- a letra ´Ã´, para designar o encontro vocálico ´ãu´ que ocorre em palavras
terminadas por ´am´, como na palavra falam (/falãu/), transcrita como /falÃ/.
- a letra ´K´, para designar a transcrição /ks/ para a letra ´x´, que ocorre em
palavras como fixo (/fikso/), transcrita como /fiKo/.


REGRAS DE CONVERSÃO ARQUIVO REGRAS.CON
; Simbolos utilizados
;
; # - delimitador de palavra
; $ - vogais
; * - consoante
; ¬ - m ou n
;

/a,a,1
,¬*,ã,2,
,¬,Ã,2,
,¬,ã,2,t
/
/b,b,1
/
/c,k,1
,e,s,1,
,ê,s,1,
,é,s,1,
,i,s,1,
,í,s,1,
,a,k,1,
,o,k,1,
,u,k,1,
,h,x,2,
/
/d,d,1
/
/e,e,1
,¬,E,1,
/
/f,f,1
/
/g,g,1
,ue,g,2,
,uê,g,2,
,ui,g,2,
,i,j,1,
,e,j,1,
,ü,g,1,
/
/h,,1
,,,1,
,,,1,
/
/i,i,1
/
/j,j,1
/
/k,k,1
/
/l,l,1
,h,L,2,
,*,|,1,
,,|,1,
/
/m,m,1
/
/n,n,1
,h,N,2,
/
/o,o,1
,so,o,1,
,sa#,ó,1,
/
/p,p,1
/
/q,k,1
,ua,k,1,
,uâ,k,1
,ue,k,2,
,uê,k,2
,ui,k,2,
,uo,k,1,
,uô,k,1
,ü,k,1
/
/r,r,1
,,R,1,
,r,,1,
r,,R,1,
,*,h,1,
,,h,1,
/
/s,s,1
,,s,1,
,,s,1,
,ce,,1,
,ci,,1,
,ç,,1,
$,$,z,1,
,s,,1,
s,,s,1,
$,*,s,1,
ex,$,z,1,
*,$,s,1,
/
/t,t,1
,h,t,2,
/
/u,u,1
/
/v,v,1
/
/w,w,1
/
/x,x,1
,,x,1,
,ce,,1,
,ci,,1,
n,,x,1,
ai,,x,1,
ei,,x,1,
ou,,x,1,
e,$,z,1,
e,s$,,1,
,*,s,1,
/
/y,i,1
/
/z,z,1
,,z,1,
,,s,1,
,*,s,1,
/
/ã,ã,1
/
/õ,õ,1
/
/á,a,1
/
/é,é,1
/
/í,i,1
/
/ó,ó,1
/
/ú,u,1
/
/â,a,1
,¬,ã,1,t
/
/ê,e,1
/
/î,i,1
/
/ô,o,1
/
/û,u,1
/
/ç,s,1
/
/ü,u,1
/
´


José Henrique

José Henrique

Curtidas 0

Respostas

Motta

Motta

27/03/2005

o uso é livre ?


GOSTEI 0
José Henrique

José Henrique

27/03/2005

É claro, Motta. Nem caberia eu pedir que os colegas avaliassem a rotina e dessem sugestões para depois restingir o uso, né? É livre!!! :D


GOSTEI 0
Motta

Motta

27/03/2005

Estas rotinas em geral convertem a string para um valor alfa-númerico montado com base na transcrição fonetica, o que permite uma busca aproximada mais acurada, pode-se até aproximar mais ou menos, se a rotina retornar um valor númerico.

veja a rotina do Oracle

SQLWKS> select ´MOTA´,SOUNDEX(´MOTA´) SDX
2> FROM DUAL
3>
´MOT SDX
---- ----
MOTA M300
1 row selected.
SQLWKS> select ´MOTTA´,SOUNDEX(´MOTTA´) SDX
2> FROM DUAL
3>
´MOTT SDX
----- ----
MOTTA M300
1 row selected.
SQLWKS> select ´MOITA´,SOUNDEX(´MOITA´) SDX
2> FROM DUAL
3>
´MOIT SDX
----- ----
MOITA M300


Testei para alguns casos e me pareceu legal


GOSTEI 0
Beppe

Beppe

27/03/2005

É possível otimizar a função:

* V, V1, C, CN podem ser const´s
* Ao invés de concatenações, pode usar uma TStringStream
* Ao invés de Copy, compare caracter por caracter

Mas já foi bem astuto ao usar # como sentinelas. :) Eu usaria apenas ao final. Veja se não é possível testar o começo da string com n = 1, e buferizar o ultimo caractere examinado.

Quando tiver mais tempo dou uma olhada nas questões que você deixou em aberto.


GOSTEI 0
POSTAR