时间戳

首页 > 解决方案 > R根据辅助数据框更改数据框值

r - R根据辅助数据框更改数据框值

问题描述

我正在寻找一种更有效的方法来进行一些替换/查找。

我目前的方法是使用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并且值匹配，我们要替换所述val用 NA 替换声明 - 我们希望独立地为值列执行此操作。

我想出的方法使用循环遍历列并创建查找值的查找。

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

标签： rperformancedataframereplace

解决方案

以下解决方案仅使用矢量化逻辑。它使用您已经制作的查找表。我认为它会比 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'] == "--", ]

推荐阅读