优化数据框中的替换

Question

这是基于名称对中的模式对更新列对的扩展。 因此，这部分是出于好奇，部分是出于娱乐。

在提出该问题的答案时，我想到这可能是for循环比*apply函数更有效的情况之一（而且我一直在寻找*apply是不一定比构造良好的for循环“更有效”）。 因此，我想再次提出这个问题，并问是否有人能够使用*apply函数（或者说purr如果那是你的事）编写的解决方案比我在下面编写的for循环要好。 将通过我的笔记本电脑（运行R 3.3.2的廉价Windows盒）上的微microbenchmark评估执行时间来判断性能。

也欢迎data.table和dplyr建议。 （我已经在计划要保存的所有微秒数）。

挑战

考虑数据帧：

col_1 <- c(1,2,NA,4,5)
temp_col_1 <-c(12,2,2,3,4)
col_2 <- c(1,23,423,NA,23)
temp_col_2 <-c(1,2,23,4,5)

df_test <- data.frame(col_1, temp_col_1, col_2, temp_col_2) 
set.seed(pi)
df_test <- df_test[sample(1:nrow(df_test), 1000, replace = TRUE), ]

对于每个col_x ，用相应的值替换丢失的值temp_col_x 。 因此，例如：

  col_1 temp_col_1 col_2 temp_col_2
1     1         12     1          1
2     2          2    23          2
3    NA          2   423         23
4     4          3    NA          4
5     5          4    23          5

变成

  col_1 temp_col_1 col_2 temp_col_2
1     1         12     1          1
2     2          2    23          2
3     2          2   423         23
4     4          3     4          4
5     5          4    23          5

现有解决方案

我已经写过的for循环

temp_cols <- names(df_test)[grepl("^temp", names(df_test))]
cols <- sub("^temp_", "", temp_cols)

for (i in seq_along(temp_cols)){
  row_to_replace <- which(is.na(df_test[[cols[i]]]))
  df_test[[cols[i]]][row_to_replace] <- df_test[[temp_cols[i]]][row_to_replace]
 }

到目前为止，我最好的apply功能是：

lapply(names(df_test)[grepl("^temp_", names(df_test))],
       function(tc){
         col <- sub("^temp_", "", tc)
         row_to_replace <- which(is.na(df_test[[col]]))
         df_test[[col]][row_to_replace] <<- df_test[[tc]][row_to_replace]
       })

标杆管理

随着（如果）提出建议，我将开始在对该问题的编辑中显示基准。 （编辑：代码现在是弗兰克答案的副本，但是按照承诺在我的计算机上运行了100次）

library(magrittr)
library(data.table)
library(microbenchmark)
set.seed(pi)

nc = 1e3
nr = 1e2
df_m0 = sample(c(1:10, NA_integer_), nc*nr, replace = TRUE) %>% matrix(nr, nc) %>% data.frame
df_r  = sample(c(1:10), nc*nr, replace = TRUE) %>% matrix(nr, nc) %>% data.frame


microbenchmark(times = 100,
               for_vec = {
                 df_m <- df_m0
                 for (col in 1:nc){
                   w <- which(is.na(df_m[[col]]))
                   df_m[[col]][w] <- df_r[[col]][w]
                 }
               }, lapply_vec = {
                 df_m <- df_m0
                 lapply(seq_along(df_m),
                        function(i){
                          w <- which(is.na(df_m[[i]]))
                          df_m[[i]][w] <<- df_r[[i]][w]
                        })

               }, for_df = {
                 df_m <- df_m0
                 for (col in 1:nc){
                   w <- which(is.na(df_m[[col]]))
                   df_m[w, col] <- df_r[w, col]
                 }
               }, lapply_df = {
                 df_m <- df_m0
                 lapply(seq_along(df_m),
                        function(i){
                          w <- which(is.na(df_m[[i]]))
                          df_m[w, i] <<- df_r[w, i]
                        })
               }, mat = { # in lmo's answer
                 df_m <- df_m0
                 bah = is.na(df_m)
                 df_m[bah] = df_r[bah]
               }, set = {
                 df_m <- copy(df_m0)
                 for (col in 1:nc){
                   w = which(is.na(df_m[[col]]))
                   set(df_m, i = w, j = col, v = df_r[w, col])
                 }
               }
)

结果：

Unit: milliseconds
       expr       min        lq      mean    median        uq      max neval cld
    for_vec 135.83875 157.84548 175.23005 166.60090 176.81839 502.0616   100  b 
 lapply_vec 135.67322 158.99496 179.53474 165.11883 178.06968 551.7709   100  b 
     for_df 173.95971 204.16368 222.30677 212.76608 224.78188 446.6050   100   c
  lapply_df 181.46248 205.57069 220.38911 215.08505 223.98406 381.1006   100   c
        mat 129.27835 154.01248 173.11378 159.83070 169.67439 453.0888   100  b 
        set  66.86402  81.08138  86.32626  85.51029  89.58331 123.1926   100 a  

Answer 1

Data.table提供了set函数来通过引用修改data.tables或data.frames。

这是一个基准，它相对于列数和行数更为灵活，并且避开了OP中笨拙的列名内容：

library(magrittr)
nc = 1e3
nr = 1e2
df_m0 = sample(c(1:10, NA_integer_), nc*nr, replace = TRUE) %>% matrix(nr, nc) %>% data.frame
df_r  = sample(c(1:10), nc*nr, replace = TRUE) %>% matrix(nr, nc) %>% data.frame

library(data.table)
library(microbenchmark)
microbenchmark(times = 10,
  for_vec = {
    df_m <- df_m0
    for (col in 1:nc){
      w <- which(is.na(df_m[[col]]))
      df_m[[col]][w] <- df_r[[col]][w]
    }
    }, lapply_vec = {
    df_m <- df_m0
    lapply(seq_along(df_m), function(i){
          w <- which(is.na(df_m[[i]]))
          df_m[[i]][w] <<- df_r[[i]][w]
    })
  }, for_df = {
    df_m <- df_m0
    for (col in 1:nc){
      w <- which(is.na(df_m[[col]]))
      df_m[w, col] <- df_r[w, col]
    }
    }, lapply_df = {
    df_m <- df_m0
    lapply(seq_along(df_m), function(i){
          w <- which(is.na(df_m[[i]]))
          df_m[w, i] <<- df_r[w, i]
    })
  }, mat = { # in lmo's answer
    df_m <- df_m0
    bah = is.na(df_m)
    df_m[bah] = df_r[bah]
  }, set = {
    df_m <- copy(df_m0)
    for (col in 1:nc){
      w = which(is.na(df_m[[col]]))
      set(df_m, i = w, j = col, v = df_r[w, col])
    }
  }
)

这使...

Unit: milliseconds
       expr       min        lq      mean    median        uq      max neval
    for_vec  77.06501  89.53430 100.10051  96.33764 106.13486 142.1329    10
 lapply_vec  77.67366  89.04438  98.81510  99.08863 108.86491 117.2956    10
     for_df 103.79097 130.33134 140.95398 144.46526 157.11335 161.4507    10
  lapply_df  97.04616 114.17825 126.10633 131.20382 137.64375 149.7765    10
        mat  73.47691  84.51473 100.16745 103.44476 112.58006 128.6166    10
        set  44.32578  49.58586  62.52712  56.30460  71.63432 101.3517    10

评论：

• 如果我们调整nc和nr或NA的频率，这四个选项的排名可能会改变。 我猜cols越多， mat方式（来自@lmo的答案）和set方式的外观就越好。

• set测试中的copy我们在实践中看到的要花费更多的时间，因为set函数只是通过引用修改表（我认为这与其他选项不同）。

Answer 2

这是一个可读的解决方案。 可能比某些慢。

df_test[c(TRUE, FALSE)][is.na(df_test[c(TRUE, FALSE)])] <- 
df_test[c(FALSE, TRUE)][is.na(df_test[c(TRUE, FALSE)])]

可以通过预先分配替换来加快速度，因此仅执行一次。

filler <- is.na(df_test[c(TRUE, FALSE)])
df_test[c(TRUE, FALSE)][filler] <- df_test[c(FALSE, TRUE)][filler]

---

在两个data.frame场景df1和df2中，此逻辑为

filler <- is.na(df1)
df1[filler] <- df2[filler]

Answer 3

也许这很幼稚，但是两者都不怎么样？ 我认为如果您正在寻找最快的方法，这仍然是本着精神。 我怀疑不是那样的。

col_1 <- c(1,2,NA,4,5)
temp_col_1 <-c(12,2,2,3,4)
col_2 <- c(1,23,423,NA,23)
temp_col_2 <-c(1,2,23,4,5)

df_test <- data.frame(col_1, temp_col_1, col_2, temp_col_2) 
set.seed(pi)
df_test <- df_test[sample(1:nrow(df_test), 1000, replace = TRUE), ]

df_test$col_1 <- ifelse(is.na(df_test$col_1), df_test$temp_col_1,df_test$col_1)
df_test$col_2 <- ifelse(is.na(df_test$col_2), df_test$temp_col_2,df_test$col_2)