按事件历史记录

Question

i有一个像这样结构的数据表，我一直在跟踪过程。如果发生了一个事件，那么我在那天旁边标记了一个1，否则为0。>

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

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

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

您可以将此习语与非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>

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