【发布时间】：2017-01-06 17:38:48
【问题描述】：
这是Update pairs of columns based on pattern in their names 的扩展。因此，这部分是出于好奇，部分是出于娱乐。
在开发该问题的答案时，我想到这可能是 for 循环比 *apply 函数更有效的情况之一（我一直在寻找一个很好的例子*apply 不一定比构造良好的 for 循环“更有效”）。所以我想再次提出这个问题，并询问是否有人能够使用*apply 函数（或purr，如果那是你的事情）编写一个比我写的for 循环更好的解决方案以下。性能将根据执行时间来判断，通过我的笔记本电脑上的microbenchmark 评估（运行 R 3.3.2 的廉价 Windows 机器）。
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
【问题讨论】：
-
apply()本身就是for循环伙伴。你有第一个投票支持:) -
啊，是的。谢谢！
-
我认为如果你去掉列解析位，它会更值得进行基准测试；把它做成两张桌子。如果有人依赖于列解析，那么他们可能无论如何都不关心速度。此外，对于基准只坚持两列有点奇怪，不是吗？