有條件地在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

我能夠使用以下代碼片段完成此任務：

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)))

但是，隨着id數據幀大小的增加，這種方法的擴展性極差。 我認為這是因為rbind功能。 另外，如果沒有非常優雅的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值。