通过R中variables的模糊匹配进行合并

我有两个数据框(x和y),其中ID是student_namefather_namemother_name 。 由于印刷错误(“n”,而不是“m”,随机空白等),我有大约60%的价值观没有alignment,虽然我可以眼球的数据,看到他们应该。 有没有办法降低不匹配的水平,以便手动编辑,因为至less可行? 数据框有大约700K的观测值。

R会是最好的。 我知道一些python和一些基本的unix工具。 PS我读了agrep() ,但不明白如何可以在实际的数据集上工作,特别是当匹配超过一个variables。


更新(发布奖励的数据):

这里有两个示例数据框, sites_asites_b 。 它们可以在数字列latlon以及sitename列上匹配。 知道如何在a) lat + lon ,b) sitename或c)两者上完成这将是有用的。

您可以获取作为要点发布的文件test_sites.R 。

理想情况下,答案会以

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

Solutions Collecting From Web of "通过R中variables的模糊匹配进行合并"

使用Levenshtein编辑距离进行近似字符串匹配的agrep函数(基本R的一部分)可能值得尝试。 不知道你的数据是什么样的,我真的不能建议一个工作的解决方案。 但这是一个建议…它在一个单独的列表中记录匹配(如果有多个同样好的匹配,那么这些匹配也会被记录下来)。 假设你的data.frame被称为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 } } } } 

mother_name的代码基本上是一样的。 你甚至可以把它们放在一个循环中,但这个例子只是为了说明的目的。

这需要一个常用的列名称列表,根据所有这些列的agrep匹配组合,然后如果all.xall.y等于TRUE,则它会追加填充缺失列的不匹配的记录与NA。 与merge不同,每个数据框中需要匹配的列名相同。 挑战似乎是正确设置agrep选项,以避免虚假匹配。

  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")] }