Question

这是Update pairs of columns based on pattern in their names的扩展。因此，这部分是出于好奇心，部分是为了娱乐。

在开发该问题的答案时，我发现这可能是for循环比*apply函数更有效的情况之一（我一直在寻找很好地说明*apply不一定比构造良好的for循环更“有效”。所以我想再次提出问题，并询问是否有人能够使用*apply函数（或purr，如果这是你的东西）编写解决方案，其性能优于{{1}我在下面写过。性能将根据我的笔记本电脑上的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

基准

当（如果）建议进来时，我将开始在此问题的编辑中显示基准。（编辑：代码现在是Frank答案的副本，但在我的机器上运行了100次，如所承诺的那样）

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

结果：

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

Answer 1

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

这是一个基于cols和行数更灵活的基准测试，并且可以回避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 s的频率，则这四个选项的排名可能会发生变化。我想那里的cols越多，mat方式（来自@ lmo的答案）和set方式就越好。
copy测试中的set需要额外的时间超出我们在实践中看到的时间，因为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)

优化数据框中的替换

挑战

现有解决方案

基准

3 个答案: