我有一个data.table，包含POSIXct格式的时间序列和一些功能（参见下面的示例）。我想在时间戳周围添加一个包含w秒窗口内行数的列。
基本上我需要的是......
dt[, COUNT := 0]
for(i in seq(nrow(dt))) {
interval_start <- dt[i,(TIMESTAMP - w)]
interval_end <- dt[i,(TIMESTAMP + w)]
dt[i, "COUNT"] <- nrow(dt[TIMESTAMP > interval_start & TIMESTAMP < interval_end])
}
......这显然非常慢，通常不是这样做的。我使用lapply()，.SD，传递给lapply()的自定义函数，滚动连接，但没有让它工作，我玩了很多。
我并不认为这里的第一篇文章显然很容易。
TIMESTAMP FEAT1 FEAT2 COUNT (w = 2000 secs)
1: 2017-11-16 02:50:19 2332843 1282 2
2: 2017-11-16 03:01:38 40913 129 2
3: 2017-11-16 08:07:03 2758077 15281 1
4: 2017-11-16 09:33:31 156899 448 1
5: 2017-11-16 11:00:04 3639410 1901 2
6: 2017-11-16 11:01:50 46274 242 2
7: 2017-11-16 12:00:46 3336248 1975 1
8: 2017-11-16 16:31:16 3262457 1006 2
9: 2017-11-16 16:37:33 3110064 840 2
10: 2017-11-16 17:23:06 3059651 765 3
11: 2017-11-16 17:31:57 51569 143 3
12: 2017-11-16 17:35:17 2254123 899 3
13: 2017-11-16 18:32:47 2321751 1182 3
14: 2017-11-16 19:02:11 469452 1257 3
15: 2017-11-16 19:02:23 2248207 923 3
16: 2017-11-16 19:40:25 62245 150 1
17: 2017-11-16 20:54:38 2245512 936 2
18: 2017-11-16 21:26:35 4191734 1044 3
19: 2017-11-16 21:30:08 2202018 958 2
20: 2017-11-16 23:42:37 2434562 2559 1
更新
现在我正在使用@ Gautam的方法进行一些调整以提高速度。一些实验表明，这比循环快得多（20k行：35对7秒，100k行：408对175秒）。
tme <- dt$tme
lower <- tme - w
upper <- tme + w
dt$count <- sapply(1:length(tme ), function(z) return(sum(tme > lower[z] & tme < upper[z])))
但是，如果有人知道这样做的“数据表”方式，我很想知道。
答案 0 :(得分：2)
这也可以使用 non-equi join 解决，这似乎也快得多（参见下面的基准）
w <- 2000
DT[, COUNT := DT[.(lb = TIMESTAMP - w, ub = TIMESTAMP + w),
on = .(TIMESTAMP > lb, TIMESTAMP < ub), by = .EACHI, .N]$N][]
TIMESTAMP FEAT1 FEAT2 COUNT 1: 2017-11-16 02:50:19 2332843 1282 2 2: 2017-11-16 03:01:38 40913 129 2 3: 2017-11-16 08:07:03 2758077 15281 1 4: 2017-11-16 09:33:31 156899 448 1 5: 2017-11-16 11:00:04 3639410 1901 2 6: 2017-11-16 11:01:50 46274 242 2 7: 2017-11-16 12:00:46 3336248 1975 1 8: 2017-11-16 16:31:16 3262457 1006 2 9: 2017-11-16 16:37:33 3110064 840 2 10: 2017-11-16 17:23:06 3059651 765 3 11: 2017-11-16 17:31:57 51569 143 3 12: 2017-11-16 17:35:17 2254123 899 3 13: 2017-11-16 18:32:47 2321751 1182 3 14: 2017-11-16 19:02:11 469452 1257 3 15: 2017-11-16 19:02:23 2248207 923 3 16: 2017-11-16 19:40:25 62245 150 1 17: 2017-11-16 20:54:38 2245512 936 2 18: 2017-11-16 21:26:35 4191734 1044 3 19: 2017-11-16 21:30:08 2202018 958 2 20: 2017-11-16 23:42:37 2434562 2559 1
DT <- readr::read_table(
" TIMESTAMP FEAT1 FEAT2 COUNT
1: 2017-11-16 02:50:19 2332843 1282 2
2: 2017-11-16 03:01:38 40913 129 2
3: 2017-11-16 08:07:03 2758077 15281 1
4: 2017-11-16 09:33:31 156899 448 1
5: 2017-11-16 11:00:04 3639410 1901 2
6: 2017-11-16 11:01:50 46274 242 2
7: 2017-11-16 12:00:46 3336248 1975 1
8: 2017-11-16 16:31:16 3262457 1006 2
9: 2017-11-16 16:37:33 3110064 840 2
10: 2017-11-16 17:23:06 3059651 765 3
11: 2017-11-16 17:31:57 51569 143 3
12: 2017-11-16 17:35:17 2254123 899 3
13: 2017-11-16 18:32:47 2321751 1182 3
14: 2017-11-16 19:02:11 469452 1257 3
15: 2017-11-16 19:02:23 2248207 923 3
16: 2017-11-16 19:40:25 62245 150 1
17: 2017-11-16 20:54:38 2245512 936 2
18: 2017-11-16 21:26:35 4191734 1044 3
19: 2017-11-16 21:30:08 2202018 958 2
20: 2017-11-16 23:42:37 2434562 2559 1")
setDT(DT)[, c("X1", "COUNT") := NULL][]
# create data
w <- 2000
nr <- 2e3L
set.seed(123)
DT0 <- data.table(TIMESTAMP = sort(as.POSIXct("2017-11-16") + sample(w * nr, nr)),
FEAT1 = sample(1e6L, nr, TRUE),
FEAT2 = sample(1e4L, nr, TRUE))
library(microbenchmark)
bm <- microbenchmark(
gautam = {
dt <- copy(DT0)
tme <- dt$TIMESTAMP
lower <- tme - w
upper <- tme + w
dt$count <- sapply(1:length(tme), function(z) return(sum(tme > lower[z] & tme < upper[z])))
},
cpak = {
dt <- copy(DT0)
dt$count <- apply(abs(outer(dt$TIMESTAMP, dt$TIMESTAMP, "-")), 2, function(i) sum(i < w))
},
nej = {
DT <- copy(DT0)
DT[, COUNT := DT[.(lb = TIMESTAMP - w, ub = TIMESTAMP + w), on = .(TIMESTAMP > lb, TIMESTAMP < ub), by = .EACHI, .N]$N][]
},
times = 11L
)
print(bm)
对于2 K行，Gautam和CPak方法的时间约为0.3秒，与OP's observations一致。但是，非equi join 的速度要快75倍。
Unit: milliseconds expr min lq mean median uq max neval gautam 269.222847 271.422632 278.196025 273.433669 284.92651 296.377010 11 cpak 269.657768 271.262771 294.905138 273.239062 275.24474 413.822440 11 nej 3.465766 3.539532 3.620397 3.589308 3.63731 3.901027 11
这种速度优势随着问题的大小而增加。如果行数加倍到4 K行，则CPak的时间接近＆＃34;爆炸＆＃34;超过4秒。因此，这种方法被排除在进一步的基准之外。
Unit: milliseconds expr min lq mean median uq max neval gautam 608.54028 616.835039 620.353603 625.129801 626.260266 627.39073 3 cpak 3901.07978 4044.341991 4168.566908 4187.604199 4302.310471 4417.01674 3 nej 5.43377 6.423977 8.372348 7.414183 9.841636 12.26909 3
对于10 K行， non-equi join 比Gautam的方法快约200倍：
Unit: milliseconds expr min lq mean median uq max neval gautam 1914.750641 1921.824429 1947.393708 1928.414685 1945.286100 2048.810492 11 nej 9.142423 9.234898 9.382176 9.467979 9.507603 9.577044 11
如果行数加倍（20 K行），则Gautam接近的处理时间几乎增加到三倍，达到5.4秒，这与OP报告的时间一致。但是，非equi join 方法现在快了300倍：
Unit: milliseconds expr min lq mean median uq max neval gautam 5369.1104 5389.17756 5406.53040 5409.24468 5425.2404 5441.23607 3 nej 17.2523 17.25648 17.27597 17.26066 17.2878 17.31495 3
我没有耐心测试1M排的情况。
答案 1 :(得分：1)
快速而肮脏的解决方案（不使用data.table）：
数据
想想我会为其他人添加数据以尝试
> dput(d)
structure(list(tme = structure(c(1510800619, 1510801298, 1510819623,
1510824811, 1510830004, 1510830110, 1510833646, 1510849876, 1510850253,
1510852986, 1510853517, 1510853717, 1510857167, 1510858931, 1510858943,
1510861225, 1510865678, 1510867595, 1510867808, 1510875757), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), feat1 = c(2332843L, 40913L, 2758077L,
156899L, 3639410L, 46274L, 3336248L, 3262457L, 3110064L, 3059651L,
51569L, 2254123L, 2321751L, 469452L, 2248207L, 62245L, 2245512L,
4191734L, 2202018L, 2434562L), feat2 = c(1282L, 129L, 15281L,
448L, 1901L, 242L, 1975L, 1006L, 840L, 765L, 143L, 899L, 1182L,
1257L, 923L, 150L, 936L, 1044L, 958L, 2559L)), .Names = c("tme",
"feat1", "feat2"), class = c("data.table", "data.frame"), row.names = c(NA,
-20L), .internal.selfref = <pointer: 0x0000000000120788>)
代码
d$count <- sapply(1:nrow(d), function(z) return(sum(d$tme %in% (d$tme[z]-2000):(d$tme[z]+2000))))
<强>输出
> d
tme feat1 feat2 count
1: 2017-11-16 02:50:19 2332843 1282 2
2: 2017-11-16 03:01:38 40913 129 2
3: 2017-11-16 08:07:03 2758077 15281 1
4: 2017-11-16 09:33:31 156899 448 1
5: 2017-11-16 11:00:04 3639410 1901 2
6: 2017-11-16 11:01:50 46274 242 2
7: 2017-11-16 12:00:46 3336248 1975 1
8: 2017-11-16 16:31:16 3262457 1006 2
9: 2017-11-16 16:37:33 3110064 840 2
10: 2017-11-16 17:23:06 3059651 765 3
11: 2017-11-16 17:31:57 51569 143 3
12: 2017-11-16 17:35:17 2254123 899 3
13: 2017-11-16 18:32:47 2321751 1182 3
14: 2017-11-16 19:02:11 469452 1257 3
15: 2017-11-16 19:02:23 2248207 923 3
16: 2017-11-16 19:40:25 62245 150 1
17: 2017-11-16 20:54:38 2245512 936 2
18: 2017-11-16 21:26:35 4191734 1044 3
19: 2017-11-16 21:30:08 2202018 958 2
20: 2017-11-16 23:42:37 2434562 2559 1
我在%in%调用中仅使用sapply作为示例，您可能希望使用<和>来代替哪个应该处理任何时间戳秒有一个小数点等。2000也不需要硬编码。
我确信使用data.table有更优雅的方法。希望这有用！
答案 2 :(得分：0)
使用@ Gautam的数据
我建议使用outer
window <- 2000
apply(abs(outer(dt$tme, dt$tme, "-")), 2, function(i) sum(i < window))
# 2 2 1 1 2 2 1 2 2 3 3 3 3 3 3 1 2 3 2 1
outer(dt$tme, dt$tme, "-")计算每次成对比较的时间差 - 结果是矩阵
abs(...)取时差的绝对值（矩阵）
apply(..., 2, function(i) ...)将函数应用于矩阵列式
function(i) sum(i < window) - 对于每列返回逻辑的总和 - 是元素＆lt;窗口？