подсчет событий по истории событий с помощью R - PullRequest
Новая
       27

подсчет событий по истории событий с помощью R

1 голос
/ 25 июня 2019

У меня есть таблица данных, которая имеет такую ​​структуру, где я отслеживал процессы. Если событие произошло, я отмечал 1 рядом с ним в тот день, иначе 0. Я показал первые несколько событий здесь, но в реальном наборе данных много много строк (более 500 000), с множеством уникальных идентификаторов процесса. 

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 и многих методах фильтрации таблиц.

Ответы [ 2 ]

2 голосов
/ 25 июня 2019

Вы можете объединить эту идиому с неэквивалентным соединением: 

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>
0 голосов
/ 25 июня 2019

Я не совсем уверен, что это по сути лучше, но вот примерно другой способ сделать что-то подобное.

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
...