【发布时间】：2016-03-12 04:38:13
【问题描述】：
我已对在不同时间步收集的数据进行了分组。在每个时间步内，有几个值的注册。每个值可能在时间步内和时间步之间出现一次或多次。
一些玩具数据：
df <- data.frame(grp = rep(1:2, each = 8),
time = c(rep(1, 3), rep(2, 2), rep(3, 3)),
val = c(1, 2, 1, 2, 3, 2, 3, 4, 1, 2, 3, 1, 1, 1, 2, 3))
df
# grp time val
# 1 1 1 1
# 2 1 1 2
# 3 1 1 1
# 4 1 2 2
# 5 1 2 3
# 6 1 3 2
# 7 1 3 3
# 8 1 3 4
# 9 2 1 1
# 10 2 1 2
# 11 2 1 3
# 12 2 2 1
# 13 2 2 1
# 14 2 3 1
# 15 2 3 2
# 16 2 3 3
目标
我希望在扩展的时间窗口内进行一些计算，即在时间步 1 内，在时间 1 和 2 内，在时间 1、2 和 3 内，等等。在每个窗口中，我希望计算唯一值的数量、多次出现的值的数量以及多次出现的值的比例。
例如，在我的玩具数据中，在组 (grp) 1 中，在第二个时间窗口（时间 = 1 和 2 一起）中注册了三个唯一值（val 1、2、3）（n_val = 3） .其中两个 (1, 2) 出现不止一次 (n_re = 2)，导致“re_rate”为 0.67（见下文）。
我的 data.table 代码产生了预期的结果。在小型数据集上，它比我的base 尝试慢，我认为这很公平，因为 data.table 代码中可能存在一些开销。对于更大的数据集，data.table 代码会赶上，但仍然较慢。我预计（希望）好处会更早出现。
因此，让我发布这个问题的原因是我相信 我的代码的 相对 性能是我滥用 data.table 的有力指标（我确信原因是 not data.table 性能本身）。因此，我的问题的主要目的是获得一些关于如何以更具 data.table 风格的方式编写代码的建议。例如，是否可以通过矢量化计算来完全避免时间窗口上的循环，如图所示。在@Khashaa here 的精彩回答中。如果没有，有没有办法让循环和赋值更有效率？
我的data.table 代码：
library(data.table)
f_dt <- function(df){
setDT(df, key = c("grp", "time", "val"))[ , {
# key or not only affects speed marginally
# unique time steps
times <- .SD[ , unique(time)]
# index vector to loop over
idx <- seq_along(times)
# pre-allocate data table
d2 <- data.table(time = times,
n_val = integer(1),
n_re = integer(1),
re_rate = numeric(1))
# loop to generate expanding window
for(i in idx){
# number of registrations per val
n <- .SD[time %in% times[seq_len(i)], .(n = .N), by = val][ , n]
# number of unique val
set(x = d2, i = i, j = 2L, length(n))
# number of val registered more than once
set(x = d2, i = i, j = 3L, sum(n > 1))
}
# proportion values registered more than once
d2[ , re_rate := round(n_re / n_val, 2)]
d2
}
, by = grp]
}
...它给出了预期的结果：
f_dt(df)
# grp time n_val n_re re_rate
# 1: 1 1 2 1 0.50
# 2: 1 2 3 2 0.67
# 3: 1 3 4 3 0.75
# 4: 2 1 3 0 0.00
# 5: 2 2 3 1 0.33
# 6: 2 3 3 3 1.00
对应base代码：
f_by <- function(df){
do.call(rbind,
by(data = df, df$grp, function(d){
times <- unique(d$time)
idx <- seq_along(times)
d2 <- data.frame(grp = d$grp[1],
time = times,
n_val = integer(1),
n_re = integer(1),
re_rate = numeric(1))
for(i in idx){
dat <- d[d$time %in% times[seq_len(i)], ]
tt <- table(dat$val)
n_re <- sum(tt > 1)
n_val <- length(tt)
re_rate <- round(n_re / n_val, 2)
d2[i, ] <- data.frame(d2$grp[1], time = times[i], n_val, n_re, re_rate)
}
d2
})
)
}
时间：
上面的小玩具数据：
library(microbenchmark)
microbenchmark(f_by(df),
f_dt(df),
times = 10,
unit = "relative")
# Unit: relative
# expr min lq mean median uq max neval
# f_by(df) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 10
# f_dt(df) 1.481724 1.450203 1.474037 1.452887 1.521378 1.502686 10
一些更大的数据：
set.seed(123)
df <- data.frame(grp = sample(1:100, 100000, replace = TRUE),
time = sample(1:100, 100000, replace = TRUE),
val = sample(1:100, 100000, replace = TRUE))
microbenchmark(f_by(df),
f_dt(df),
times = 10,
unit = "relative")
# Unit: relative
# expr min lq mean median uq max neval
# f_by(df) 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 10
# f_dt(df) 1.094424 1.099642 1.107821 1.096997 1.097693 1.194983 10
不，数据仍然不是大，但我希望 data.table 现在能赶上。如果编码正确......我相信这表明我的代码有很大的改进潜力。非常感谢任何建议。
【问题讨论】：
标签： r performance data.table