使用 R 按事件历史记录事件计数

Question

我有一个这样结构的数据表，我在其中跟踪流程。如果发生了事件，那么我在当天将其标记为 1，否则标记为 0。我在这里展示了前几个事件，但真正的数据集有很多行（超过 500,000 行），有很多唯一的进程 ID。

process_id    date         event
00001       01/01/12     0
00002       01/01/12     1
00003       01/01/12     0
...         ...          ...
00001       01/01/19     1
00002       01/01/19     0
00003       01/01/19     1

我现在想知道的是对于每个观察（行），如果该 process_id 在去年（不包括当前日期）发生了事件，并添加一个表示标志的列。假设该行

00002       10/01/18     1

出现在表中，那么输出表可能看起来像

process_id     date         event    previousEvent     
00001          01/01/12     0        NA
00002          01/01/12     1        NA
00003          01/01/12     0        NA
...            ...          ...      ...
00001          01/01/19     1        0
00002          01/01/19     0        1
00003          01/01/19     1        0

我目前的做法是使用dplyr 工具包进行过滤，但是我认为由于它不是矢量化方法，因此它可能不是最有效的做事方式。将doSNOW 包用于并行化方法，程序的主循环如下所示。它只是计算事件发生的次数，以确定事件是否在去年发生。但是，即使这种方法也需要很长时间（我的机器上这么多行大约需要一个小时）

result <- foreach(i = 1:nrow(data),
              .options.snow=opts, .combine='rbind', .packages = 'dplyr') 
 %dopar%
{
  d <- nrow(data%>%
      filter(process_id %in% data[i,]$process_id ) %>%
      filter(date>= data[i,]$LastYearDate) %>%
      filter(date< data[i,]$date) %>%
      filter(event > 0))
  return(ifelse(d,1,0))
}

有没有更好的方法？我对 R 和过滤表的许多技术非常陌生。

Answer 1

您可以将this idiom 与非等连接结合起来：

library(data.table)
library(lubridate)

df <- read.table(header=T, text="
process_id    date         event
00001       00/01/20     1
00002       00/01/20     1
00003       00/01/20     0
00001       01/01/19     1
00002       01/01/19     0
00003       01/01/19     1")

dt <- as.data.table(df)

dt[, date := as.POSIXct(date, format = "%y/%m/%d")]
dt[, prev_year := date - lubridate::dyears(1L)]

positives <- dt[.(1), .(process_id, date, event), on = "event"]

dt[, prev_event := positives[.SD,
                             .(x.event),
                             on = .(process_id, date < date, date >= prev_year),
                             mult = "last"]]

print(dt)
   process_id       date event  prev_year prev_event
1:          1 2000-01-20     1 1999-01-20         NA
2:          2 2000-01-20     1 1999-01-20         NA
3:          3 2000-01-20     0 1999-01-20         NA
4:          1 2001-01-19     1 2000-01-20          1
5:          2 2001-01-19     0 2000-01-20          1
6:          3 2001-01-19     1 2000-01-20         NA

必要时调整日期格式， 如果你不需要它，然后删除prev_year。

如果您还想添加上一个事件发生的日期， 将print之前的行改为：

dt[, `:=`(
  c("prev_event", "prev_date"),
  positives[.SD, .(x.event, x.date), on = .(process_id, date < date, date >= prev_year), mult = "last"]
)]

---

有点无耻的插件： 使用新版table.express， 你也可以把上面写成：

library(table.express)
library(data.table)
library(lubridate)

dt <- as.data.table(df) %>%
  start_expr %>%
  mutate(date = as.POSIXct(date, format = "%y/%m/%d")) %>%
  mutate(prev_year = date - lubridate::dyears(1L)) %>%
  end_expr

positives <- dt %>%
  start_expr %>%
  filter_on(event = 1) %>%
  select(process_id, date, event) %>%
  end_expr

dt %>%
  start_expr %>%
  mutate_join(positives,
              process_id, date > date, prev_year <= date,
              mult = "last",
              .SDcols = c(prev_event = "event", prev_date = "date")) %>%
  end_expr

print(dt)
   process_id       date event  prev_year prev_event  prev_date
1:          1 2000-01-20     1 1999-01-20         NA       <NA>
2:          2 2000-01-20     1 1999-01-20         NA       <NA>
3:          3 2000-01-20     0 1999-01-20         NA       <NA>
4:          1 2001-01-19     1 2000-01-20          1 2000-01-20
5:          2 2001-01-19     0 2000-01-20          1 2000-01-20
6:          3 2001-01-19     1 2000-01-20         NA       <NA>

Answer 2

我不确定这是否本质上更好，但这里大致是另一种做类似事情的方法。

library(data.table)

dt <- data.table(id = rep(1:10, each = 5), time = rep(1:5, 10), event = 0)
dt[id == 2 & time == 2 | id == 4 & time == 3, event := 1]

go <- function(x, n) {
  z <- rep(0, length(x))
  y <- unique(unlist(lapply(which(x == 1) + 1, seq, len = n)))
  y <- y[y <= length(x)]
  z[y] <- 1
  z
}

dt[, year_event := go(event, 2), id]
dt