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

counting events by event history with R

我有一个结构如下的数据 table,我在其中跟踪进程。如果发生了事件,那么那天我在它旁边标记了 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

发生在 table 中,那么输出 table 可能看起来像

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 和许多过滤 tables.

的技术还很陌生

我不确定这在本质上是否更好,但这是执行类似操作的大致另一种方法。

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

您可以将 与 non-equi 结合起来:

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>