我对在不同时间步骤收集的数据进行了分组。在每个时间步内，都有多个值注册。每个值可能在时间步内或时间步之间出现一次或多次。
一些玩具数据：
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代码赶上了，但仍然较慢。我预计（希望）好处会更早显现出来。
因此，促使我提出这个问题的是我相信the relative我的代码的性能是我滥用 data.table 的有力指标（我确信原因是notdata.table 性能本身）。因此，我的问题的主要目的是获得一些建议如何以更 data.table 式的方式进行编码。例如，是否可以通过向量化计算来完全避免时间窗口上的循环，例如所示@Khashaa 的精彩回答here https://stackoverflow.com/questions/32221695/cumulative-calculations-e-g-cumulative-correlation-with-data-table-in-r。如果没有，有没有办法使循环和赋值更有效？
My data.table code:
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 code:
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
})
)
}
Timings:
上面的小玩具数据：
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
不，数据还没有large，但我希望 data.table 现在能赶上。如果编码正确......我相信这表明我的代码有很大的改进潜力。任何建议都将受到高度赞赏。
