我对在不同时间步骤收集的数据进行了分组。在每个时间步骤内，有几个值的注册。每个值可以在时间步骤内和之间发生一次或多次。
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＆amp; 2在一起）中，已经注册了三个唯一值（val 1,2,3）（n_val = 3） ）。其中两个（1,2）出现不止一次（n_re = 2），导致＆＃34; re_rate＆＃34; 0.67（见下文）。
我的data.table代码产生了所需的结果。在一个小的数据集上，它比我的base尝试慢，我相信这是公平的，因为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
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能够赶上。如果编码正确...我相信这表明我的代码有很大的改进潜力。任何建议都非常感谢。
答案 0 :(得分：7)
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
希望这有帮助。
答案 1 :(得分：1)
正在寻找一种更好的方法来编写非重复群组的扩展窗口，并遇到了这个问题。
这个问题似乎更多地是关于扩展窗口，其中组（即问题中的时间）是重复的。以下是使用between的解决方案。
#expanding group by where groups are duplicated
library(data.table)
setDT(df)
df[ , {
#get list of unique time groups to be used in the expanding group
uniqt <- unique(time)
c(list(time=uniqt), #output time as well
#expanding window of each unique time group
do.call(rbind, lapply(uniqt, function(n) {
#tabulate the occurrences
x <- table(val[between(time, uniqt[1L], n)])
#calculate desired values
n_val <- length(x)
n_re <- sum(x > 1)
data.frame(n_val=n_val, n_re=n_re, re_rate=n_re/n_val)
})))
}, by=grp]
结果：
# grp time n_val n_re re_rate
# 1: 1 1 2 1 0.5000000
# 2: 1 2 3 2 0.6666667
# 3: 1 3 4 3 0.7500000
# 4: 2 1 3 0 0.0000000
# 5: 2 2 3 1 0.3333333
# 6: 2 3 3 3 1.0000000
我无法找到data.table首次发布的between版本，因此，between可能会在发布此问题后发布。