Fusionando a través de coincidencias aproximadas de variables en R

Question

Tengo dos dataframes (x & y) donde los ID son student_name, father_name y mother_name. Debido a errores tipográficos ("n" en lugar de "m", espacios en blanco al azar, etc.), tengo aproximadamente el 60% de los valores que no se alinean, aunque puedo ver los datos y ver si deberían. ¿Hay alguna manera de reducir el nivel de no coincidencia de alguna manera para que la edición manual sea al menos factible? Los dataframes tienen aproximadamente 700K observaciones.

R sería lo mejor. Conozco un poco de python y algunas herramientas básicas de Unix. PD Leí en agrep(), pero no entiendo cómo puede funcionar eso en los conjuntos de datos reales, especialmente cuando la coincidencia es más de una variable.

---

actualización (para los datos de recompensas publicado):

Here son dos marcos de datos de ejemplo, y sites_asites_b. Podrían coincidir en las columnas numéricas lat y lon, así como en la columna sitename. Sería útil saber cómo se podría hacer esto en a) solo lat + lon, b) sitename oc) ambos.

puede obtener el archivo test_sites.R que se publica como una esencia.

Lo ideal sería que la respuesta sería terminar con

merge(sites_a, sites_b, by = **magic**) 

Answer 1

El agrep función (parte de la base R), que hace la coincidencia de cadenas aproximada utilizando la Levenshtein edit distance es probablemente vale la pena probar. Sin saber cómo son tus datos, realmente no puedo sugerir una solución de trabajo. Pero esta es una sugerencia ... Registra las coincidencias en una lista separada (si hay varias coincidencias igualmente buenas, también se registran). Digamos que su hoja.de.datos se llama df:

l <- vector('list',nrow(df)) 
matches <- list(mother = l,father = l) 
for(i in 1:nrow(df)){ 
    father_id <- with(df,which(student_name[i] == father_name)) 
    if(length(father_id) == 1){ 
    matches[['father']][[i]] <- father_id 
    } else { 
    old_father_id <- NULL 
    ## try to find the total                                 
    for(m in 10:1){ ## m is the maximum distance                            
     father_id <- with(df,agrep(student_name[i],father_name,max.dist = m)) 
     if(length(father_id) == 1 || m == 1){ 
     ## if we find a unique match or if we are in our last round, then stop                    
     matches[['father']][[i]] <- father_id 
     break 
     } else if(length(father_id) == 0 && length(old_father_id) > 0) { 
     ## if we can't do better than multiple matches, then record them anyway                    
     matches[['father']][[i]] <- old_father_id 
     break 
     } else if(length(father_id) == 0 && length(old_father_id) == 0) { 
     ## if the nearest match is more than 10 different from the current pattern, then stop                 
     break 
     } 
    } 
    } 
} 

El código para el mother_name sería básicamente la misma. Incluso podría ponerlos juntos en un bucle, pero este ejemplo es solo con fines ilustrativos.

Answer 2

Esta toma una lista de nombres de columna comunes, coincidencias basándose en la agrep de todas esas columnas combinadas, y luego, si all.x o all.y es igual a TRUE anexa registros no coincidentes rellenando falta columnas con NA. A diferencia de merge, los nombres de columna para coincidir deben ser los mismos en cada marco de datos. El desafío parece ser establecer las opciones agrep correctamente para evitar coincidencias espurias.

agrepMerge <- function(df1, df2, by, all.x = FALSE, all.y = FALSE, 
    ignore.case = FALSE, value = FALSE, max.distance = 0.1, useBytes = FALSE) { 

    df1$index <- apply(df1[,by, drop = FALSE], 1, paste, sep = "", collapse = "") 
    df2$index <- apply(df2[,by, drop = FALSE], 1, paste, sep = "", collapse = "") 

    matches <- lapply(seq_along(df1$index), function(i, ...) { 
     agrep(df1$index[i], df2$index, ignore.case = ignore.case, value = value, 
      max.distance = max.distance, useBytes = useBytes) 
    }) 

    df1_match <- rep(1:nrow(df1), sapply(matches, length)) 
    df2_match <- unlist(matches) 

    df1_hits <- df1[df1_match,] 
    df2_hits <- df2[df2_match,] 

    df1_miss <- df1[setdiff(seq_along(df1$index), df1_match),] 
    df2_miss <- df2[setdiff(seq_along(df2$index), df2_match),] 

    remove_cols <- colnames(df2_hits) %in% colnames(df1_hits) 

    df_out <- cbind(df1_hits, df2_hits[,!remove_cols]) 

    if(all.x) { 
     missing_cols <- setdiff(colnames(df_out), colnames(df1_miss)) 
     df1_miss[missing_cols] <- NA 
     df_out <- rbind(df_out, df1_miss) 
    } 
    if(all.x) { 
     missing_cols <- setdiff(colnames(df_out), colnames(df2_miss)) 
     df2_miss[missing_cols] <- NA 
     df_out <- rbind(df_out, df2_miss) 
    } 
    df_out[,setdiff(colnames(df_out), "index")] 
}