匹配和填充R中数据框的空白

Question

我有双重条目的数据，看起来像这样：

+-----+-------+-----------+-----------+--------+
| id  | first |   last    | birthyear | father |
+-----+-------+-----------+-----------+--------+
| a12 | linda | john      | 1991      | NA     |
| 3n8 | max   | well      | 1915      | NA     |
| 15z | linda | NA        | 1991      | dan    |
| 1y9 | pam   | degeneres | 1855      | NA     |
| 84z | NA    | degeneres | 1950      | hank   |
| 9i5 | max   | well      | NA        | mike   |
+-----+-------+-----------+-----------+--------+

一个人有多个条目，但每个条目都有需要保留的唯一数据。 我想合并这些条目，保留所有信息。 只有“id”列不必匹配，我想保留列表中的第一个“id”条目作为最后的“id”。 所以我的最终数据框看起来像这样：

+-----+-------+-----------+-----------+--------+
| id  | first |   last    | birthyear | father |
+-----+-------+-----------+-----------+--------+
| a12 | linda | john      | 1991      | dan    |
| 3n8 | max   | well      | 1915      | mike   |
| 1y9 | pam   | degeneres | 1855      | NA     |
| 84z | NA    | degeneres | 1950      | hank   |
+-----+-------+-----------+-----------+--------+

在此示例中，有两个姓氏为“degeneres”的条目没有合并，因为出生年份不匹配。 只有匹配条目（除了 NAs）的条目确实被合并了。

到目前为止，我得到的最远的是生成一个按匹配名字排序的列表：

df <- data.frame(id = c("a12", "3n8", "15z", "1y9", "84z", "9i5"), first = c("linda", "max", "linda", "pam", NA, "max"), last = c("john", "well", NA, "degeneres", "degeneres", "well"), birthyear = c("1991", "1915", "1991", "1855", "1950", NA), father = c(NA, NA, "dan", NA, "hank", "mike"), stringsAsFactors = F)

name_list <- list()
i <- 1
for(n in df$first) {
  name_list[[i]] <- df[df$first == n,]
  i <<- i + 1
}

我还尝试以一种有意义的方式应用合并，但这并没有给我想要的结果：

merge(x = df, y = df, by = c("first", "last", "birthyear", "father"))

+---------+-----------+-----------+--------+------+------+
|   first |   last    | birthyear | father | id.x | id.y |
+---------+-----------+-----------+--------+------+------+
| linda   | john      | 1991      | <NA>   | a12  | a12  |
| linda   | NA        | 1991      | dan    | 15z  | 15z  |
| max     | well      | 1915      | NA     | 3n8  | 3n8  |
| max     | well      | NA        | mike   | 9i5  | 9i5  |
| NA      | degeneres | 1950      | hank   | 84z  | 84z  |
| pam     | degeneres | 1855      | NA     | 1y9  | 1y9  |
+---------+-----------+-----------+--------+------+------+

我怎样才能最好地进行？

编辑：

感谢到目前为止的回复： 只是为了清楚。 我不想保守地确定哪一行描述了一个独特的人，例如：这个输入：

+-----+-------+------+-----------+--------+
| id  | first | last | birthyear | father |
+-----+-------+------+-----------+--------+
| 9i5 | max   | well | NA        | mike   |
| 9i6 | dan   | well | NA        | mike   |
| 9i7 | NA    | well | NA        | NA     |
+-----+-------+------+-----------+--------+

需要给出这个输出：

+-----+-------+------+-----------+--------+
| id  | first | last | birthyear | father |
+-----+-------+------+-----------+--------+
| 9i5 | max   | well | NA        | mike   |
| 9i6 | dan   | well | NA        | mike   |
+-----+-------+------+-----------+--------+

编辑2：

所以我在我的数据集上使用了 Adam 的脚本。 它工作得很好，只有一个小问题，因为正是 Salix 预测/发现的问题。 我有一个关于我名叫琳达的女人的数据很少的行。 事实证明，有两个 Linda 绝对是独一无二的，第三个名为 Linda 的条目没有更多信息。

脚本现在正试图将未知的琳达与另外两个独特的琳达相匹配。 我已将问题追溯到 merge_id 对象中的冲突。 对于我的数据集，它看起来像这样：

+------+------+
| V1   | V2   |
+------+------+
|  188 |  916 |
|  188 | 1048 |
|  752 | 1048 |
|  916 | 1048 |
| 1048 | 1058 |
+------+------+

如您所见，人 1048 与彼此不匹配的人匹配。 因此，例如 188 - 916 - 1048 可能都是同一个人，因为 188 匹配 916，188 匹配 1048，916 匹配 1048。没问题。

但是然后人752也匹配到1048，但是不匹配到188或者916。所以，1048没有足够的信息，需要删除。

我试图想出一个函数来检测这种碰撞并从数据集中删除 1048。

Answer 1

您可以先按 df 排序，然后检查每一行是否与它下面的行匹配。 当它出现时，您将 NA 值替换为另一行的值。 然后你可以删除重复项。

我调整了之前的函数以在保留 ID 的同时进行最佳合并，并简化了它，因为您不需要额外的参数。

我添加了条目以更好地测试。

新功能：

 merge_rows <- function(df, orderCol = 0){
  if(orderCol[1]==0){ #if no column is used to sort --> replace missing values
    df <- merge_rows(df)
  } else { #else --> sort, then replace missing values
    for(L in c(T, F)){ #depending on how NAs are ordered, you get different results, so doing it both ways to assure better merging
      for(i in 1:length(orderCol)){
        df <- df[order(df[orderCol[i]], na.last=L),]
        row = 2 #counter and not for loop because size of df changes
        while(row <= nrow(df)){
          r1 = row-1
          r2 = row
          #compare the 2 rows & checks that it's a match (no conflicting data)
          is_match = sum((df[r1,-1] == df[r2,-1])==F, na.rm = T) == 0  # -1 for id col
          #if it's a match --> fill missing info of row 1 and remove row 2
          if(is_match) {
            df[r1, is.na(df[r1,])] <- df[r2, is.na(df[r1,])]
            df <- df[-r2, ]
          } 
          row = row+1
        }
      }
    }
  }
  rownames(df) <- NULL #rename your row in order
  return(df) #return new df
}

merge_rows(df, 2:3) #in my case 2:3 gave same result as 2:5, depending on your columns, you might need to adjust

结果：

   id first      last birthyear father
1 84z  <NA> degeneres      1950   hank
2 1y9   pam degeneres      1855   <NA>
3 a12 linda      john      1991    dan
4 d33 linda      well      1991 robert
5 3n8   max      well      1915   mike

使用的 df：

df <- data.frame(
    id = c("d33","d34","a11", "a12", "3n8", "15z", "ba4", "1y9", "84z", "9i5"), 
    first = c("linda","linda",NA, "linda", "max", "linda", "max", "pam", NA, "max"), 
    last = c("well","well","john", "john", "well", NA, NA, "degeneres", "degeneres", "well"), 
    birthyear = c("1991","1991","1991", "1991", "1915", "1991", NA, "1855", "1950", NA), 
    father = c(NA,"robert",NA, NA, NA, "dan", NA, NA, "hank", "mike"), 
    stringsAsFactors = T)

Answer 2

我不确定这有多有效，但这似乎有效。 我正在使用 3 个自定义函数。

如果连续有两个 NA 和其他类似情况，这将很容易适应它不匹配。 主要技巧是在f_compare()中构建两个数据帧，代表每个行组合进行比较而不是循环。

职能：

f_compare()

将每一行与其自身进行比较。 我们使用combn()来开发所有唯一的行组合。 此函数将返回一个包含两列的矩阵。 这两列指定“重复”的行号 - 定义为忽略第一列并将NA计为匹配项。

编辑：扩展逻辑以强制最少数量的字段按值实际匹配，而不是来自NA通配符。 我们要求行中TRUE匹配值的数量加上行中NA值的数量等于字段总数。

Edit2：添加了检查以查看记录是否“坏”。 如果存在匹配对 (a, b) 和 (c, b)，它会检查 (a, c) 或 (c, a) 是否也是一对。 如果不是，则违规记录 c 将从数据库中删除。 同样，这可以很容易地适应标记而不是删除该行。

f_compare <- function(dat, .min_match = 1, .exclude_cols = c(1)) {
  
  # grid of unique row id combinations
  dat_rows <- t(combn(seq_len(nrow(dat)), 2))
  
  # grid of all row id combinations (e.g., (1, 2) and (2, 1))
  dat_rows_all <- expand.grid(seq_len(nrow(dat)), seq_len(nrow(dat)))
  dat_rows_all <- dat_rows_all[dat_rows_all[,1] != dat_rows_all[,2], ]
  
  # function to find record matches based on a grid specification
  f_match <- function(dat, dat_rows, .min_match, .exclude_cols) {
    
    compare <- dat[dat_rows[, 1], -.exclude_cols] == dat[dat_rows[, 2], -.exclude_cols]
    
    row_true <- rowSums(compare, na.rm = TRUE)
    row_na <- rowSums(is.na(compare))
    
    which_rows <- which((row_true >= .min_match) & (row_true + row_na == ncol(compare)))
    rbind(dat_rows[which_rows,])
    
  }
  
  # matches for each grid
  match_rows <- f_match(dat, dat_rows, .min_match, .exclude_cols)
  match_rows_all <- f_match(dat, dat_rows_all, .min_match, .exclude_cols)
  
  # function to determine if it is a "bad" record
  f_bad <- function(check_index, id_comb, id_all) {
    
    if (length(id_comb[id_comb[,2] == check_index, 1]) > 1) {
      trans_rows <- t(combn(id_comb[id_comb[,2] == check_index, 1], 2))
    
      compare_trans <- id_all[rep(seq_len(nrow(id_all)), times = nrow(trans_rows)),] == trans_rows[rep(seq_len(nrow(trans_rows)), each = nrow(id_all)),]
    
      return(!any(rowSums(compare_trans) == ncol(compare_trans)))
    } else {
      return(FALSE)
    }
  }
  
  # check all rows with a potential match to see if it is "bad"
  check_ids <- unique(match_rows[,2])
  
  if (length(check_ids) > 0) {
    bad_ids <- check_ids[sapply(check_ids, f_bad, match_rows, match_rows_all)]
  } else {
    bad_ids = check_ids
  }
  
  list(id = rbind(match_rows[!(match_rows[,2] %in% bad_ids), ]), bad_id = bad_ids)

}

f_merge()

给定两个向量x和y ，用彼此的值填充每个向量中的NA槽。

f_merge <- function(id, dat) {
  x <- dat[id[1],]
  y <- dat[id[2],]
  
  y[is.na(y)] <- x[is.na(y)]
  x[is.na(x)] <- y[is.na(x)]
  
  x
}

合并记录（）

递归地处理数据集，直到没有更多的重复项需要合并。 这里有一些案例逻辑来解释诸如 R 将单行矩阵转换为向量以及何时退出递归之类的事情。

Edit2：修改合并以删除“坏”记录。

merge_records <- function(dat) {
  merge_id <- f_compare(dat)
  
  # drop bad rows
  if (length(merge_id$bad_id) > 0) {
    dat <- dat[-merge_id$bad_id,]
  }
  
  dat2 <- do.call("rbind", apply(merge_id$id, 1, f_merge, dat = dat))
  dat2 <- rbind(dat2, dat[which(!(seq_len(nrow(dat)) %in% c(merge_id$id))), ])
  
  if (nrow(dat2) > 1) {
    dat2 <- dat2[which(!(duplicated(dat2))),]
    
    if (nrow(f_compare(dat2)$id) > 0) merge_records(dat2) else return(dat2)
  } else {
    dat2
  }
  
}

最终结果：

merge_records(df)

    id first      last birthyear father
1  a12 linda      john      1991    dan
21 3n8   max      well      1915   mike
5  1y9   pam degeneres      1855   <NA>
6  84z  <NA> degeneres      1950   hank

Answer 3

作为另一个答案发布，因为它使用不同的方法。

受 Adam 函数的启发和对我的原始函数的改进，我制作了一个小而简化的函数，它提供与另一个函数相同的结果，同时至少快两倍（根据基准函数）。

mergeRows <- function(df) {
  #list of rows to compare
  rows <- t(combn(1:nrow(df), 2))
  #finds first pair of rows with no conflicting dfa (no need to check that there's a match if we know there's no false match)
  is_T = which(rowSums((df[rows[, 1],-1] == df[rows[, 2],-1])==F, na.rm = T) == 0)[1]
  while(!is.na(is_T)){ 
    id <- rows[is_T,]
    df[id[1], is.na(df[id[1],])] <- df[id[2], is.na(df[id[1],])]
    df <- df[-id[2],]
    #list of rows to compare from reduce df
    rows <- t(combn(1:nrow(df), 2))
    #finds next pair of rows with no conflicting dfa
    is_T = which(rowSums((df[rows[, 1],-1] == df[rows[, 2],-1])==F, na.rm = T) == 0)[1]
  }
  rownames(df) <- NULL #optional --> renames them in order
  return(df)
}

mergeRows(df)