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-并且我们想对值列进行独立操作。 / p>

我想到的方法是使用循环遍历各列并本质上创建一个查找值的查找。

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

R根据辅助数据帧更改数据帧值

2 个答案: