R根據輔助數據幀更改數據幀值

Question

我正在尋找一種更高效的方法來進行一些替換/查找。

我當前的方法是使用paste0創建查找值，然后對其進行匹配以進行過濾。

給定x ，

x <- data.frame(var1 = c("AA","BB","CC","DD"), 
                var2 = c("--","AA","AA","--"), 
                val1 = c(1,2,1,4), 
                val2 = c(5,5,7,8))

  var1 var2 val1 val2
1   AA   --    1    5
2   BB   AA    2    5
3   CC   AA    1    7
4   DD   --    4    8

var1是主列， var2是輔助列。 val1和val2是值列。

如果var2是var1一個值並且值匹配，則我們要用NA替換指定的val並且我們希望對value列獨立進行此操作。

我想出的方法是使用循環遍歷列並本質上創建查找值的查找。

lookup.df <- x %>% filter(var2 == "--")

x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
  var2.lookup <- paste0(x$var2,x[[column]])
  var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])

  x[[column]][var2.lookup %in% var1.lookup] <- NA

  return(x[[column]])
})

確實返回了我期望的結果。

> x
  var1 var2 val1 val2
1   AA   --    1    5
2   BB   AA    2   NA
3   CC   AA   NA    7
4   DD   --    4    8

但是，在實踐中，在對代碼進行性能分析時，大部分時間都花在了粘貼上–但這似乎並不是最有效的方法。

我的真實數據集是數百萬行和約25列，並且運行大約60秒。 我認為有一種方法可以進行邏輯矩陣替換，而不是分別訪問每個列。 不過我不知道。

任何幫助是極大的贊賞。 謝謝！

編輯-基准

na.replace.orig <- function(x) {
  lookup.df <- x %>% filter(var2 == "--")

  x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
    var2.lookup <- paste0(x$var2,x[[column]])
    var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])

    x[[column]][var2.lookup %in% var1.lookup] <- NA

    return(x[[column]])
  })

  return(x)
}

# pulled out the lookup table since it causes a lot of overhead
na.replace.orig.no.lookup <- function(x) {

  x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
    var2.lookup <- paste0(x$var2,x[[column]])
    var1.lookup <- paste0(lookup.df$var1,lookup.df[[column]])

    x[[column]][var2.lookup %in% var1.lookup] <- NA

    return(x[[column]])
  })

  return(x)
}

na.replace.1 <- function(x) {
  inx <- match(x$var2, x$var1)
  jnx <- which(!is.na(inx))
  inx <- inx[!is.na(inx)]
  knx <- grep("^val", names(x))

  for(i in seq_along(inx))
    for(k in knx)
      if(x[[k]][inx[i]] == x[[k]][jnx[i]]) x[[k]][jnx[i]] <- NA

  return(x)
}

na.replace.2 <- function(x) {

  for(col in c("val1","val2")) {
    x[x[,'var2'] %in% x[,'var1'] & x[,col] %in% lookup.df[,col] , col] <- NA
  }

  return(x)
}

> microbenchmark::microbenchmark(na.replace.orig(x), na.replace.orig.no.lookup(x), na.replace.1(x), na.replace.2(x), times = 10)
Unit: microseconds
                         expr     min     lq   mean median     uq    max neval
           na.replace.orig(x) 1267.23 1274.2 1441.9 1408.8 1609.8 1762.8    10
 na.replace.orig.no.lookup(x)  217.43  228.9  270.9  239.2  296.6  394.2    10
              na.replace.1(x)   98.46  106.3  133.0  123.9  136.6  239.2    10
              na.replace.2(x)  117.74  147.7  162.9  166.6  183.0  189.9    10

編輯-需要第三個變量

我意識到我需要檢查第三個變量。

x <- data.frame(var1 = c("AA","BB","CC","DD"), 
                var2 = c("--","AA","AA","--"),
                var3 = c("Y","Y","N","N"),
                val1 = c(1,2,1,4), 
                val2 = c(5,5,7,8))

  var1 var2 var3 val1 val2
1   AA   --    Y    1    5
2   BB   AA    Y    2    5
3   CC   AA    N    1    7
4   DD   --    N    4    8

與預期的結果

  var1 var2 var3 val1 val2
1   AA   --    Y    1    5
2   BB   AA    Y    2   NA
3   CC   AA    N    1    7
4   DD   --    N    4    8

我的代碼仍然適用於這種情況。

x[,c("val1","val2")] <- lapply(c("val1","val2"), function(column) {
  var2.lookup <- paste0(x$var2, x$var3, x[[column]])
  var1.lookup <- paste0(lookup.df$var1, x$var3, lookup.df[[column]])

  x[[column]][var2.lookup %in% var1.lookup] <- NA

  return(x[[column]])
})

Answer 1

以下解決方案僅使用向量化邏輯。 它使用您已經建立的查找表。 我認為它將比Rui的解決方案更快

library(dplyr)
x <- data.frame(var1 = c("AA","BB","CC","DD"), 
                var2 = c("--","AA","AA","--"), 
                val1 = c(1,2,1,4), 
                val2 = c(5,5,7,8))

lookup.df <- x[ x[,'var2'] == "--", ]

x[x[,'var2'] %in% x[,'var1'] & x[,'val1'] %in% lookup.df[,'val1'] , 'val1'] <- NA
x[x[,'var2'] %in% x[,'var1'] & x[,'val2'] %in% lookup.df[,'val2'] , 'val2'] <- NA

x
#>   var1 var2 val1 val2
#> 1   AA   --    1    5
#> 2   BB   AA    2   NA
#> 3   CC   AA   NA    7
#> 4   DD   --    4    8

編輯：

可能是，也可能不是。

set.seed(4)
microbenchmark::microbenchmark(na.replace.orig(x), na.replace.1(x), na.replace.2(x), times = 50)
#> Unit: microseconds
#>                expr     min      lq     mean   median      uq      max
#>  na.replace.orig(x) 184.348 192.410 348.4430 202.1615 223.375 6206.546
#>     na.replace.1(x)  68.127  86.621 281.3503  89.8715  93.381 9693.029
#>     na.replace.2(x)  95.885 105.858 210.7638 113.2060 118.668 4993.849
#>  neval
#>     50
#>     50
#>     50

OP，您需要在數據集上對其進行測試，以了解二者在較大數據框上的縮放比例如何不同。

編輯2：實現了Rui對查找表的建議。 按從最慢到最快的基准進行排序：

lookup.df <- x %>% filter(var2 == "--")
lookup.df <- filter(x, var2 == "--")
lookup.df <- x[x[,'var2'] == "--", ]

Answer 2

我發現以下解決方案有點令人困惑（我想出了！），但是它可以工作。
與流行的看法相反， for循環並不比*apply系列慢很多。

inx <- match(x$var2, x$var1)
jnx <- which(!is.na(inx))
inx <- inx[!is.na(inx)]
knx <- grep("^val", names(x))

for(i in seq_along(inx))
    for(k in knx)
        if(x[[k]][inx[i]] == x[[k]][jnx[i]]) x[[k]][jnx[i]] <- NA

x
#  var1 var2 val1 val2
#1   AA   --    1    5
#2   BB   AA    2   NA
#3   CC   AA   NA    7
#4   DD   --    4    8