在 R 中按行有条件地连接数据帧

Question

我想有条件地合并以下格式的两个表格：

id1 <- c('S001', 'S002', 'S003', 'S004', 'S004')
id2 <- c('S001', 'S001', 'S002', 'S002', 'S001')
ids <- data.frame(id1, id2)

和

bad_id_key <- c('S002', 'S004') 
bad_id_val <- c('a', 'b')
bad_ids <- data.frame(bad_id_key, bad_id_val)

条件规则是：

1. 如果两个 ID 都在“坏”列表中，则删除该行
2. 如果两个 ID 都不在“坏”列表中，则删除该行
3. 如果只有一个 ID 是错误的，则将错误值添加到该行。

生成的表格如下所示：

  id1  id2 bad_id_val
2 S002 S001          a
3 S003 S002          a
5 S004 S001          b

我能够使用以下代码 sn-p 完成此操作：

conditionalJoin <- function(row){
  if(row$id1 %in% bad_id_key & row$id2 %in% bad_id_key){
    # do nothing
  }
  else if(row$id1 %in% bad_id_key){
    merge(x=row, y=bad_ids, by.x="id1", by.y="bad_id_key", all.x=TRUE)
  }
  else if(row$id2 %in% bad_id_key){
    merge(x=row, y=bad_ids, by.x="id2", by.y="bad_id_key", all.x=TRUE)
  }
}

out <- do.call("rbind", as.list(by(ids, 1:nrow(ids), conditionalJoin)))

但是，随着 ids 数据框大小的增长，这种方法的扩展性极差。我认为这是因为 rbind 功能。另外，if else 不是很优雅的 R 代码。

有谁知道 R 命令可以执行这种比 rbind 更有效的逐行条件连接？提前致谢。

Answer 1

使用 data.table 包，我会按如下方式处理它：

library(data.table)
ids <- setDT(ids)[xor(id1 %in% bad_ids$bad_id_key, id2 %in% bad_ids$bad_id_key)
                  ][, bad_id_val := ifelse(id1 %in% bad_ids$bad_id_key,
                                           as.character(bad_ids$bad_id_val[match(id1, bad_ids$bad_id_key)]),
                                           as.character(bad_ids$bad_id_val[match(id2, bad_ids$bad_id_key)]))]

它给出了预期的结果：

> ids
    id1  id2 bad_id_val
1: S002 S001          a
2: S003 S002          a
3: S004 S001          b

在@jeremycg 的更大数据集上进行测试，得出以下关于速度的结果：

Unit: milliseconds
   expr        min         lq       mean     median          uq         max neval cld
 jeremy   9.196898   9.386950   9.854132   9.603002    9.749256   16.764747   100  b 
     OP 974.933816 985.813821 996.770067 992.145890 1000.411484 1143.402837   100   c
   jaap   3.572531   3.612401   3.779686   3.679115    3.790707    9.803782   100 a  

Answer 2

这是我使用dplyr 可以获得的最快速度。它要快得多，因为只有两个 match 调用，其他一切都很快。请参阅下面的基准。

library(dplyr)
ids %>% mutate(x = match(id1, bad_ids$bad_id_key), #get the first match of id1 
               y = match(id2, bad_ids$bad_id_key)) %>% #and id2
        filter(xor(is.na(x), is.na(y))) %>% #filter to make sure we have 1 match
        mutate(val = ifelse(is.na(x), #if x didn't match
                         as.character(bad_ids$bad_id_val[y]), #get the y
                         as.character(bad_ids$bad_id_val[x]))) # otherwise get the x

这是一个基于更大数据的基准：

#5000 lines of ids
set.seed(12345)
ids <- data.frame(id1 = sample(1:50, 5000, replace = TRUE), id2 = sample(1:50, 5000, replace = TRUE))
bad_ids <- data.frame(bad_id_key = 1:20, bad_id_val = letters[1:20])

microbenchmark::microbenchmark(
me = {
   ids %>% mutate(x = match(id1, bad_ids$bad_id_key),
                  y = match(id2, bad_ids$bad_id_key)) %>%
           filter(xor(is.na(x), is.na(y))) %>%
           mutate(val = ifelse(is.na(x), 
                           as.character(bad_ids$bad_id_val[y]), 
                           as.character(bad_ids$bad_id_val[x])))},
OP = {out <- do.call("rbind", as.list(by(ids, 1:nrow(ids), conditionalJoin)))}
)

Unit: milliseconds
 expr        min         lq       mean     median         uq        max
   me   11.92924   12.41934   15.36524   13.07722   15.71085   63.14211
   OP 1831.34599 1910.90149 2369.70980 2112.57251 2340.88428 5549.01191
 neval
   100
   100

Answer 3

与其使用ifelse 函数，不如仅在data.frame 或data.table 自身内工作以识别您要保留的记录。对于您的示例，您可以使用以下代码执行此操作：

ids[xor(ids$id1 %in% bad_id_key, ids$id2 %in% bad_id_key),]

运行此代码后，您只需合并 ids 和 bad_ids 以附加错误的 id 值。