一些玩具数据：
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代码产生了所需的结果.在一个小的数据集上,它比我的基本尝试慢,我相信这是公平的,因为data.table代码可能有一些开销.使用更大的数据集,data.table代码会赶上,但速度仍然较慢.我希望(希望)这些好处会更早出现.
因此,让我发布这个问题的原因是我相信我的代码的相对性能是我滥用data.table的强烈指标(我确信原因不是data.table性能本身).因此,我的问题的主要目标是获得一些关于如何以更加data.table-esque方式编码的建议.例如,是否可以通过矢量化计算来完全避免循环时间窗口,如图所示.在@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
对应基码：
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能赶上来.如果编码正确…我相信这表明我的代码有很大的改进潜力.任何建议都非常感谢.
f <- function(df){
setDT(df)[, n_val := cumsum(!duplicated(val)), grp
][, occ := 1:.N, .(grp, val)
][, occ1 := cumsum(occ == 1) - cumsum(occ == 2), grp
][, n_re := n_val - occ1,
][, re_rate := round(n_re/n_val, 2),
][, .(n_val = n_val[.N], n_re = n_re[.N], re_rate =re_rate[.N]), .(grp, time)]
}
哪里
> cumsum(！duplicated(val))计算唯一值n_val的(累积)出现次数,
> occ计算每个值的累计次数(请注意,它按val分组).
> occ1然后计算val中仅出现一次的元素数量.
当occ == 1时,值的数量仅增加1,当occ == 2时减少1;因此cumsum(occ == 1) – cumsum(occ == 2).
>多次出现的值的数量是n_val-occ1
速度比较
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))
system.time(f(df))
# user system elapsed
# 0.038 0.000 0.038
system.time(f_dt(df))
# user system elapsed
# 16.617 0.013 16.727
system.time(f_by(df))
# user system elapsed
# 16.077 0.040 16.122
希望这可以帮助.