[R-br] SoundexBR

[Fátima Lima Paula]

Olá Daniel Marcelino, precisaria de uma ajuda sua no soundex.
Verifiquei que erros de digitação não são captados pelo SoundexBR.
Exemplo:
?MARIA e MARIA, PE8DRO e PEDRO.
Será que seria tranquilo para você implementar algumas coisas?
Estou enviando um script que fiz com teste para alguns caracteres.
Desde já muito obrigada.
Abs
Fátima
soundexBR<-function(termo){
termo<-toupper(termo)
# 1. Retire toda pontuação da palavra;
termo<-gsub("[ÃÁÀÂÄ]","A",termo)
termo<-gsub("[ÉÈÊ?Ë]","E",termo)
termo<-gsub("[ÍÌÏÎI]","I",termo)
termo<-gsub("[ÓÕÒÔÖ]","O",termo)
termo<-gsub("[ÚÙÛÜU]","U",termo)
termo<-gsub("Ç","C",termo)
#1.a Substituir todas as letras duplas por uma única letra
#http://www.archives.gov/genealogy/census/soundex.html
termo<-gsub("([A-Z])\\1", "\\1", termo)
# 2. Fique com a primeira letra;
 N<-nchar(termo)
# Modificação PT-BR (Coeli e Camargo)
 termo<-ifelse(substr(termo,1,2)=="WA",sub("W","V",termo),termo)
 termo<-ifelse(substr(termo,1,1)=="H",substr(termo,2,N),termo)
termo<-ifelse(substr(termo,1,2)=="KA"|substr(termo,1,2)=="KO"|substr(termo,1,2)=="KU",sub("K","C",termo),termo)
 termo<-ifelse(substr(termo,1,1)=="Y",sub("Y","I",termo),termo)
termo<-ifelse(substr(termo,1,2)=="CE"|substr(termo,1,2)=="CI",sub("C","S",termo),termo)
termo<-ifelse(substr(termo,1,2)=="GE"|substr(termo,1,2)=="GI",sub("G","J",termo),termo)

############## Segunda Parte #######################
 termo.1<-substr(termo,1,1)
 termo<-substr(termo,2,N)
# 3. Mude todas as ocorrências das letras a seguir por '0' (zero):
'A','E','I','O','U','H','W','Y';
 termo<-gsub("[A,E,I,O,U,H,W,Y]",0,termo)
# 4. Mude as letras restantes de acordo com a tabela abaixo:
# Número Letra
# 1 'B','F','P','V'
 termo<-gsub("[B,F,P,V]",1,termo)
# 2 'C','G','J','K', 'Q','S','X','Z'
 termo<-gsub("[C,G,J,K,Q,S,X,Z]",2,termo)
# 3 'D','T'
 termo<-gsub("[D,T]",3,termo)
# 4 'L'
 termo<-gsub("L",4,termo)
# 5 'M','N'
 termo<-gsub("[M,N]",5,termo)
# 6 'R'
 termo<-gsub("R",6,termo)
# 5. Remova todos os zeros da string resultante;
 termo<-gsub(0,"",termo)
# Eliminar dois numeros iguais consecutivos por um único numero
#http://www.archives.gov/genealogy/census/soundex.html
 termo<-gsub("([0-9])\\1", "\\1", termo)
# Remontar
 termo<-paste(termo.1,termo,sep="")

# 6. Preencha a string resultante com zeros à direita e retorne desta
forma:
#<letra maiuscula><digito><digito><digito>
 termo<-paste(termo,"0000",sep="")
 termo<-substr(termo,1,4)
 return(termo)
}

soundexBR("termo")
soundexBR("terno")

nomea=data.frame(nome=c("GER?D","HARTMUT","RALF","STEFAN","ROBERT"))
nomea
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
library(RecordLinkage)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Ponto de interrogação
nomea=data.frame(nome=c("GER?D","HARTMUT","?RALF","STEFAN","ROBERT"))
nomea
nomeb=data.frame(nome=c("HARTMUT?","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Não funciona com o ? no início
###############################################################################
#Barras inclinadas /
nomea=data.frame(nome=c("GER/D","/HARTMUT","RALF/","STEFAN","ROBERT"))
nomea
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Não funciona com a barra inclinada
#Barras inclinadas \
nomea=data.frame(nome=c("GER\D","\HARTMUT","RALF\","STEFAN","ROBERT"))
nomea
#O R rejeita a \
#Parênteses (
nomea=data.frame(nome=c("GER(D","(HARTMUT","RALF(","STEFA)N","ROBERT)"))
nomea
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Só funciona com o parênteses depois do nome
#Dois pontos e ponto e vírgula
nomea=data.frame(nome=c("GER:D",":HARTMUT","RALF:","STEFA;N","ROBERT;"))
nomea
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Só funciona com o : e ; depois do nome
#Dólar e ponto
nomea=data.frame(nome=c("GER$D","%HARTMUT","RALF%","STEFA.N","ROBERT."))
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Idem
#Números
nomea=data.frame(nome=c("GER1D","2HARTMUT","RALF3","S4TEFA.N","RO5BERT6"))
nomea
nomeb=data.frame(nome=c("HARTMUT","GERD","ROBERT","STEFAN","RALF"))
nomeb
fonoa=soundexBR(nomea$nome)
fonob=soundexBR(nomeb$nome)
pairs.mat = outer(fonoa,fonob, "==")
pairs.mat
#Não funciona com números
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20130317/e0cb5573/attachment.html>