围绕给定事件有效实现编号窗口变量答案

【问题标题】：Efficient implementation of a numbered window variable around given events围绕给定事件有效实现编号窗口变量
【发布时间】：2021-11-26 23:02:48
【问题描述】：

我有一个数据集，其中包含连续的“事件”日期向量。我想在每个事件之前和之后为给定长度的窗口创建一个编号的窗口变量。我有一个可以工作的代码，但速度慢得离谱，我想知道提高其效率的最佳方法。

下面我放了代码。我还有一个函数 create_date_vector，它只保留足够分开的日期，以便在窗口中没有重叠，这更使得下面的示例运行（但显然也欢迎对此进行改进）。

data <- data.frame(day = seq(as.Date("2000-01-01"), as.Date("2001-01-01"), by = "day"))

dates <- sample(seq(as.Date("2000-01-01"), as.Date("2001-01-01"), by = "day"), 30)

pre <- 3
post <- 3

create_date_vector <- function(dates, pre, post){
  
  t_dates_dif <- diff(dates)
  selected_dates <- c()
  
  for(i in 1:(length(t_dates_dif) - 1)){
    selected_dates <- c(selected_dates, (t_dates_dif[i] > pre + post) + (t_dates_dif[i+1] > pre + post))
  }
  return(dates[which(selected_dates == 2) + 1])
}

dates_chosen <- sort(create_date_vector(dates, pre, post))

真正需要优化的是以下创建窗口的代码：

data$event <- NA
for(i in 1:length(dates_chosen)){
  data <- data %>%
    mutate(
      event = ifelse(day >= dates_chosen[i] - pre & day <= dates_chosen[i] + post, i, event)
    )
}

感谢您的帮助。

【问题讨论】：

标签： r data.table tidyverse

【解决方案1】：

事件日期周围的窗口可以通过使用辅助表在非等值连接中更新来创建

library(data.table)
# create helper table
events <- data.table(dates_chosen)[
  , `:=`(rn = .I, from = dates_chosen - pre, to = dates_chosen + post)]
# update in a non-equi join 
setDT(data)[events, on = .(day >= from, day <= to), event := rn][]

            day event
  1: 2000-01-01    NA
  2: 2000-01-02    NA
  3: 2000-01-03    NA
  4: 2000-01-04    NA
  5: 2000-01-05    NA
 ---                 
363: 2000-12-28    NA
364: 2000-12-29    NA
365: 2000-12-30    NA
366: 2000-12-31    NA
367: 2001-01-01    NA

# show only updated rows
data[!is.na(event)]

           day event
 1: 2000-05-16     1
 2: 2000-05-17     1
 3: 2000-05-18     1
 4: 2000-05-19     1
 5: 2000-05-20     1
 6: 2000-05-21     1
 7: 2000-05-22     1
 8: 2000-06-17     2
 9: 2000-06-18     2
10: 2000-06-19     2
11: 2000-06-20     2
12: 2000-06-21     2
13: 2000-06-22     2
14: 2000-06-23     2
15: 2000-10-26     3
16: 2000-10-27     3
17: 2000-10-28     3
18: 2000-10-29     3
19: 2000-10-30     3
20: 2000-10-31     3
21: 2000-11-01     3
           day event

辅助表是

events[]

   dates_chosen rn       from         to
1:   2000-05-19  1 2000-05-16 2000-05-22
2:   2000-06-20  2 2000-06-17 2000-06-23
3:   2000-10-29  3 2000-10-26 2000-11-01

【讨论】：

非常聪明，超级优雅！速度提高 33 倍！ data.table 一如既往的胜利！非常感谢！

【解决方案2】：

lead 可能会更容易

library(dplyr)
create_date_vector2 <- function(dates, pre, post) {
      t1 <- diff(dates)      
      pre_post <- pre + post
      dates[which(((t1 > pre_post) + (dplyr::lead(t1) > pre_post)) == 2) + 1]
}

-测试

> create_date_vector2(dates, 3, 3)
[1] "2011-06-17" "2008-07-30" "2002-02-19"

-OP 函数的输出

> create_date_vector(dates, pre, post)
[1] "2011-06-17" "2008-07-30" "2002-02-19"

【讨论】：

谢谢！这似乎运行得一样快，有时会有一些改进。老实说，需要优化的更多是第二部分……不过，谢谢您的回答！