7

Este problema é bastante complexo e precisa de dois estágios. O primeiro estágio consiste em corrigir erros de digitação de uma base de dados(talvez uma solução probabilística). O segundo estágio consiste em arrumar esta base de dados depois desta correção. Este segundo estágio requer uma sequência de aplicações do pacote dplyr(ou outro pacote adequado e elegante)

Vamos ao primeiro estágio. Eu tenho uma base de dados de uma empresa. A base de dados disponibilizada não revela completamente a identidade do trabalhador. Vou exemplificar a base para depois explicar as variáveis.

data <- read.table(text="
              cpf;nome;m1;m2;m3;m4;m5;m6;m7;m8;m9;m10;m11;m12;salario
              100001;Maria dos Santos Magalhães;1;0;0;0;0;0;0;0;1;0;0;0;1234
              100001;Maria Santos Magalhães;0;1;1;1;1;1;1;1;0;1;1;1;1034
              100002;Lucas Barbosa;1;1;1;1;1;1;1;1;1;1;1;1;4234 
              100002;Danilo Carvalho;1;1;1;1;1;1;1;1;1;1;1;0;7234
              100003;Paulo Silva de Fonseca;0;1;1;1;1;1;1;1;1;1;1;0;1254
              100003;Paulo Silva da Fonseca;0;0;0;0;0;0;0;0;0;0;0;1;2234
              100003;Wagner Silva Junior;1;1;1;0;0;0;0;0;0;0;0;0;4234
              100003;Paulo Silva Fonseca;1;0;0;0;0;0;0;0;0;0;0;0;1232
              100004;Ricardo Colho;1;1;1;1;1;1;1;0;1;1;1;0;5234
              100004;Ricardo Coelho;0;0;0;0;0;0;0;1;0;0;0;1;1234", h=T, sep=";")

Explicando as variáveis. Primeiro, não temos o cpf completo, só temos os 6 números do meio. A variável "nome" dispensa explicações. As variáveis do tipo m1,m2,m3, etc são os meses. Estas variáveis são binárias e 1 representa que o trabalhador trabalhou no mês em questão e 0 que não trabalhou. A variável "salario" é o valor que o trabalhador ganhou nos messes trabalhados. Os dados aqui apresentados são fictícios.

Primeira coisa a ser observada olhando cada grupo de cpfs é que existe erros de digitação. Por exemplo, o grupo cujo número do meio de cpf é 100001, temos com grande chance de que Maria dos Santos Magalhães e Maria Santos Magalhães sejam a mesma pessoa. Uma outra evidência é que se fosse duas pessoas diferentes, provavelmente teriam meses de trabalho em comum, como é o caso do cpf 100002, onde Lucas Barbosa e Danilo Carvalho são pessoas diferentes. Os outros casos seguem a mesma explicação.

Preciso de algum algoritmo que me indique, por exemplo, que Maria dos Santos Magalhães e Maria Santos Magalhães são, como probabilidade alta, a mesma pessoa. Assim como Lucas Barbosa e Danilo Carvalho são praticamente pessoas diferentes.

Uma tentativa usando adist:

teste<- data[data$cpf == 100003 , ]
(ch1<- teste$nome) 
[1] Paulo Silva de Fonseca Paulo Silva da Fonseca Wagner Silva Junior   
[4] Paulo Silva Fonseca   
10 Levels: Danilo Carvalho Lucas Barbosa ... Wagner Silva Junior

(d1 <- ch1 %>% adist())
         [,1] [,2] [,3] [,4]
[1,]        0    1   14    3
[2,]        1    0   14    3
[3,]       14   14    0   11
[4,]        3    3   11    0

Vou excluir os que tem distância zero e menor que 5 como padrão. Mas antes vou dar nome às linhas e colunas.

(d1<- as.data.frame(d1)) 
names(d1)<- ch1
row.names(d1)<- ch1
thresh=5
(teste<- which(d1 != 0 & d1 < thresh, arr.ind=TRUE) )
                        row col
 Paulo Silva da Fonseca   2   1
 Paulo Silva Fonseca      4   1
 Paulo Silva de Fonseca   1   2
 Paulo Silva Fonseca      4   2
 Paulo Silva de Fonseca   1   4
 Paulo Silva da Fonseca   2   4

Reparem que neste caso particular, Wagner Silva Junior não tem nenhuma ligação com os outros. A partir de agora, começa o segundo estágio: Com esta matriz de distâncias, eu gostaria de fazer uma série de manipulações de maneira a arrumar os nomes, os meses trabalhados e o salário. Em resumo, gostaria de algo como isto:

      cpf                       nome m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 salario

2  100001     Maria Santos Magalhães  1  1  1  1  1  1  1  1  1   1   1   1    2268
3  100002              Lucas Barbosa  1  1  1  1  1  1  1  1  1   1   1   1    4234
4  100002            Danilo Carvalho  1  1  1  1  1  1  1  1  1   1   1   0    7234
5  100003     Paulo Silva de Fonseca  1  1  1  1  1  1  1  1  1   1   1   1    4720
7  100003        Wagner Silva Junior  1  1  1  0  0  0  0  0  0   0   0   0    4234
9  100004              Ricardo Colho  1  1  1  1  1  1  1  1  1   1   1   1    6468

Acredito que uma série de funções usando o dplyr possa resolver este segundo estágio

4
  • conseguiu resolver? Commented 26/09/2016 às 1:29
  • @FlavioBarros , Não
    – MAOC
    Commented 27/09/2016 às 23:33
  • 1
    @orrillo ainda interessa a solução? pois tenho algo em mente, e posso desenvolver a resposta! Commented 26/10/2018 às 13:01
  • Pode postar. Sempre é bom a contribuição
    – MAOC
    Commented 26/10/2018 às 14:56

1 Resposta 1

4

Introdução

Eu tive um problema similar a esse em 2017, e eu resolvi a partir da lógica Fuzzy, com base nesse link de 2016.

No link, o autor explica que ele pega cada setença (que nesse caso é um nome completo), separa por palavra e usa a distância de Levenshtein para calcular quanto uma palavra está distante da outra, e por fim, pondera pelo tamanho das palavras (resumidamente é isso).

No final, o código resulta em um score fuzzy da correspondência das palavras (quanto maior melhor, e +Inf implica numa correspondência exata).

Corrigir erros de digitação

Carregam-se as funções:

############################################################################ ###
### FUZZY MATCHING FUNCTIONS                                                  ####
############################################################################ ###
fuzzy_prep_words <- function(words) {
  # Prepares a list of words for fuzzy matching. All the other fuzzy matching
  # functions will run word through this. Given a list of sentences, returns
  # a list of words.

  words <- unlist(strsplit(tolower(gsub("[[:punct:]]", " ", words)), "\\W+"))
  return(words)
}

fuzzy_gen_word_freq <- function(l, fun = identity) {
  # Returns a word frequency vector based on vector of sentences l and with
  # frequencies post-processed by fun (e.g. log)

  fun(sort(table(fuzzy_prep_words(unlist(strsplit(l, ' ')))), decreasing=T))+1
}

fuzzy_title_match <- function(a, b, wf) {
  # Fuzzy matches a performance title based on a custom algorithm tuned for
  # this purpose. Words are frequency-weighted (like tf-idf).
  # 
  # Args:
  #   a, b: the two titles to match
  #   wf: a vector of word frequencies as generated by fuzzy_gen_word_freq
  #
  # Returns:
  #   A fuzzy match score, higher is better, +Inf for exact match

  if (a == b) # Shortcut to make faster
    return (Inf)
  a.words <- fuzzy_prep_words(a)
  b.words <- fuzzy_prep_words(b)
  a.freqs <- sapply(a.words, function(x) { ifelse(is.na(wf[x]), 1, wf[x]) })
  b.freqs <- sapply(b.words, function(x) { ifelse(is.na(wf[x]), 1, wf[x]) })

  d <- adist(a.words, b.words)
  a.matches <- 1-apply(d, 1, function(x) { min(x, 2) })/2
  b.matches <- 1-apply(d, 2, function(x) { min(x, 2) })/2

  matchsum <- min(sum(a.matches * 1/a.freqs), sum(b.matches * 1/b.freqs))
  unmatchsum <- sum(floor(1-a.matches) * 1/a.freqs) + sum(floor(1-b.matches) * 1/b.freqs)
  return(matchsum / unmatchsum)
}

Nomes que você quer calcular o escore fuzzy (nesse caso, é o mesmo nome):

A <- as.character(data$nome)
B <- as.character(data$nome)

Aplique nas funções:

wf <- fuzzy_gen_word_freq(c(A, B))
vectorised_match <- function (L1,L2) { mapply(function(a,b) { fuzzy_title_match(a, b, wf) }, L1, L2) } 
scores <- outer(A, B, vectorised_match)
rownames(scores) <- A
colnames(scores) <- B

Retorna uma matriz com o score fuzzy da distância entre cada um dos nomes:

> scores
                           Maria dos Santos Magalhães Maria Santos Magalhães Lucas Barbosa Danilo Carvalho Paulo Silva de Fonseca Paulo Silva da Fonseca Wagner Silva Junior
Maria dos Santos Magalhães                        Inf                    1.8             0               0             0.00000000             0.00000000          0.00000000
Maria Santos Magalhães                            1.8                    Inf             0               0             0.00000000             0.00000000          0.00000000
Lucas Barbosa                                     0.0                    0.0           Inf               0             0.00000000             0.00000000          0.00000000
Danilo Carvalho                                   0.0                    0.0             0             Inf             0.00000000             0.00000000          0.00000000
Paulo Silva de Fonseca                            0.0                    0.0             0               0                    Inf                    Inf          0.08641975
Paulo Silva da Fonseca                            0.0                    0.0             0               0                    Inf                    Inf          0.08641975
Wagner Silva Junior                               0.0                    0.0             0               0             0.08641975             0.08641975                 Inf
Paulo Silva Fonseca                               0.0                    0.0             0               0             1.19047619             1.19047619          0.11666667
Ricardo Colho                                     0.0                    0.0             0               0             0.00000000             0.00000000          0.00000000
Ricardo Coelho                                    0.0                    0.0             0               0             0.00000000             0.00000000          0.00000000
                           Paulo Silva Fonseca Ricardo Colho Ricardo Coelho
Maria dos Santos Magalhães           0.0000000             0              0
Maria Santos Magalhães               0.0000000             0              0
Lucas Barbosa                        0.0000000             0              0
Danilo Carvalho                      0.0000000             0              0
Paulo Silva de Fonseca               1.1904762             0              0
Paulo Silva da Fonseca               1.1904762             0              0
Wagner Silva Junior                  0.1166667             0              0
Paulo Silva Fonseca                        Inf             0              0
Ricardo Colho                        0.0000000           Inf            Inf
Ricardo Coelho                       0.0000000           Inf            Inf

Em teoria, somente, isso deveria funcionar, mas não é o caso:

A <- as.data.frame(A)
names(A) <- c("nome")
A$Nome1 <- colnames(scores)[apply(scores,1,which.max)]
A
                         nome                      Nome1
1  Maria dos Santos Magalhães Maria dos Santos Magalhães
2      Maria Santos Magalhães     Maria Santos Magalhães
3               Lucas Barbosa              Lucas Barbosa
4             Danilo Carvalho            Danilo Carvalho
5      Paulo Silva de Fonseca     Paulo Silva de Fonseca
6      Paulo Silva da Fonseca     Paulo Silva de Fonseca
7         Wagner Silva Junior        Wagner Silva Junior
8         Paulo Silva Fonseca        Paulo Silva Fonseca
9               Ricardo Colho              Ricardo Colho
10             Ricardo Coelho              Ricardo Colho

Mas como pode ser visto, não funcionou para as "Marias" e o "Paulo", então, são necessários mais manipulações nessa matriz de distâncias (a lógica Fuzzy já parou aqui, daqui para frente, é uma forma que eu pensei em solucionar).

Basicamente pego o escore e coloco na tabela dos nomes, faço uma tabela a partir da Pontuação, filtro aqueles com valores maiores que 1, e atribuo os nomes (a partir da tabela de nomes) às pontuações:

scores[is.infinite(scores)] <- NA # Faço isso, pois a correspondência exata de nomes já foi atribuída
A$Pontuacao <- as.numeric(apply(scores,1,max, na.rm = T))
tab <- table(A$Pontuacao)
# O ponto de corte a ser definido foi "1", mas isso pode ser melhor estudado a partir de uma amostra maior
aux <- tab[tab>1]
aux <- aux[names(aux)!="0"]
aux <- as.data.frame(aux)
aux <- aux[, -2, drop = F]
names(aux) <- "Pontuacao"
aux <- merge(aux, A[, c(2,3)], all.x = T)

Aqui, a partir da tabela de nomes original, eu faço um merge com a tabela que criei, e reatribuo os nomes a partir do ifelse:

aux <- aux[!duplicated(aux$Pontuacao), ]
aux$Pontuacao <- as.character(aux$Pontuacao)
A$Pontuacao <- as.character(A$Pontuacao)
names(aux)[2] <- "NomeNovo"
A <- merge(A, aux, all.x = T)
A$NomeNovo <- ifelse(is.na(A$NomeNovo), as.character(A$Nome1), as.character(A$NomeNovo))

           Pontuacao                       nome                      Nome1                   NomeNovo
1                  0              Ricardo Colho              Ricardo Colho              Ricardo Colho
2                  0             Ricardo Coelho              Ricardo Colho              Ricardo Colho
3                  0              Lucas Barbosa              Lucas Barbosa              Lucas Barbosa
4                  0            Danilo Carvalho            Danilo Carvalho            Danilo Carvalho
5  0.116666666666667        Wagner Silva Junior        Wagner Silva Junior        Wagner Silva Junior
6   1.19047619047619        Paulo Silva Fonseca        Paulo Silva Fonseca     Paulo Silva de Fonseca
7   1.19047619047619     Paulo Silva de Fonseca     Paulo Silva de Fonseca     Paulo Silva de Fonseca
8   1.19047619047619     Paulo Silva da Fonseca     Paulo Silva de Fonseca     Paulo Silva de Fonseca
9                1.8 Maria dos Santos Magalhães Maria dos Santos Magalhães Maria dos Santos Magalhães
10               1.8     Maria Santos Magalhães     Maria Santos Magalhães Maria dos Santos Magalhães

Tratamento de uma base de dados

Agora é fácil! Basta fazer o merge dos dados originais, com a tabela dos nomes arrumados, e somar as colunas agrupando pelo nome e CPF:

data2 <- merge(data, A[, c("nome", "NomeNovo")])
# Somo os salários e os meses pelo CPF e Nome
data2 <- aggregate(. ~ NomeNovo + cpf, data2[, -c(1)], sum)

# Aqui, é possível fazer um teste se algum nome foi agrupado de forma indevida
data2 <- data2[rowSums(data2[, -c(1:2, ncol(data2))])<=12, ]
# Como Não foi, eu paro por aqui, mas outras melhorias poderiam ser feitas
data2
                    NomeNovo    cpf m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 salario
1 Maria dos Santos Magalhães 100001  1  1  1  1  1  1  1  1  1   1   1   1    2268
2            Danilo Carvalho 100002  1  1  1  1  1  1  1  1  1   1   1   0    7234
3              Lucas Barbosa 100002  1  1  1  1  1  1  1  1  1   1   1   1    4234
4     Paulo Silva de Fonseca 100003  1  1  1  1  1  1  1  1  1   1   1   1    4720
5        Wagner Silva Junior 100003  1  1  1  0  0  0  0  0  0   0   0   0    4234
6              Ricardo Colho 100004  1  1  1  1  1  1  1  1  1   1   1   1    6468

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .