自上一事件以来经过的时间计算

Question

我有一个包含多个主题（id）和重复观测值（以时间time记录）的数据框。每个时间可能与事件（event）相关联，也可能不相关。可以使用以下代码生成示例数据框：

set.seed(12345)
id <- c(rep(1, 9), rep(2, 9), rep(3, 9))
time <- c(seq(from = 0, to = 96, by = 12),
      seq(from = 0, to = 80, by = 10),
      seq(from = 0, to = 112, by = 14))
random <- runif(n = 27)
event <- rep(100, 27)

df <- data.frame(cbind(id, time, event, random))
df$event <- ifelse(df$random < 0.55, 0, df$event)
df <- subset(df, select = -c(random))
df$event <- ifelse(df$time == 0, 100, df$event)

我希望能够计算事件之间的时间差（tae [time after the last event]），理想输出如下：

head(ideal_df)
  id time event tae
1  1    0   100   0
2  1   12   100   0
3  1   24   100   0
4  1   36   100   0
5  1   48     0  12
6  1   60     0  24

在Fortran中，我使用以下代码来创建tae变量:

IF(EVENT.GT.0) THEN
  TEVENT = TIME
  TAE = 0
ENDIF

IF(EVENT.EQ.0) THEN
  TAE = TIME - TEVENT
ENDIF

在R中，我尝试过使用ifelse和dplyr两种方法。然而，两者都不能产生我想要的输出。

# Calculate the time since last event (using ifelse)
df$tae <- ifelse(df$event >= 0, df$tevent = df$time & df$tae = 0, df$tae = df$time - df$tevent)

Error: unexpected '=' in "df$tae <- ifelse(df$event >= 0, df$tevent ="

# Calculate the time since last event (using dplyr)
res <- df %>%
  arrange(id, time) %>%
  group_by(id) %>%
  mutate(tae = time - lag(time))
res 

   id time event tae
1   1    0   100  NA
2   1   12   100  12
3   1   24   100  12
4   1   36   100  12
5   1   48     0  12
6   1   60     0  12

显然，这两种方法都无法产生我想要的输出。似乎在ifelse函数中分配变量不被R所容忍。我尝试使用dplyr解决方案，但没有考虑到event变量...

最后，还需要记录下一个事件的时间tue。如果有人能够想到如何进行这个（可能更棘手的）计算，请随时分享。

任何关于如何使其中之一工作（或替代解决方案）的想法都将不胜感激。谢谢！

附：当ID内的事件间隔发生变化时，以下是一个可重现的示例：

id <- rep(1, 9)
time <- c(0, 10, 22, 33, 45, 57, 66, 79, 92)
event <- c(100, 0, 0, 100, 0, 100, 0, 0, 100)
df <- data.frame(cbind(id, time, event))

head(df)
  id time event
1  1    0   100
2  1   10     0
3  1   22     0
4  1   33   100
5  1   45     0
6  1   57   100

- Entropy

Answer 1

这是一个使用dplyr的方法：

library(dplyr)
df %>%
  mutate(tmpG = cumsum(c(FALSE, as.logical(diff(event))))) %>%
  group_by(id) %>%
  mutate(tmp_a = c(0, diff(time)) * !event,
         tmp_b = c(diff(time), 0) * !event) %>%
  group_by(tmpG) %>%
  mutate(tae = cumsum(tmp_a),
         tbe = rev(cumsum(rev(tmp_b)))) %>%
  ungroup() %>%
  select(-c(tmp_a, tmp_b, tmpG))

新的列包括事件后时间（tae）和事件前时间（tbe）。

结果：

   id time event tae tbe
1   1    0   100   0   0
2   1   12   100   0   0
3   1   24   100   0   0
4   1   36   100   0   0
5   1   48     0  12  48
6   1   60     0  24  36
7   1   72     0  36  24
8   1   84     0  48  12
9   1   96   100   0   0
10  2    0   100   0   0
11  2   12     0  12  24
12  2   24     0  24  12
13  2   36   100   0   0
14  2   48     0  12  48
15  2   60     0  24  36
16  2   72     0  36  24
17  2   84     0  48  12
18  2   96     0  60   0
19  3    0   100   0   0
20  3   12   100   0   0
21  3   24     0  12  24
22  3   36     0  24  12
23  3   48   100   0   0
24  3   60   100   0   0
25  3   72   100   0   0
26  3   84     0  12  12
27  3   96   100   0   0

第二个例子的结果：

  id time event tae tbe
1  1    0   100   0   0
2  1   10     0  10  23
3  1   22     0  22  11
4  1   33   100   0   0
5  1   45     0  12  12
6  1   57   100   0   0
7  1   66     0   9  26
8  1   79     0  22  13
9  1   92   100   0   0

- Sven Hohenstein

---

太好了！您认为能否将此代码改编以计算下一个事件的时间？ - Entropy

对于这个非常好的解决方案点赞。如果你想要移除临时变量 tmp2，你应该在 select(-tmp, -tmp2) 之前插入 ungroup()。 - Jaap

谢谢--我很抱歉之前没有意识到，但是如果在ID内间隔发生变化，rev(cumsum(...))函数将无法产生正确的结果。请参见我在上面帖子中的编辑，以获取可重现的示例。 - Entropy

在这两个例子中，时间=0时有一个事件。当我运行这段代码时，对于第一个事件之前的行，“tae”会给出奇怪的结果。同样，在您的示例中，最后一行有一个事件；当最后一行没有事件时，“tbe”似乎无法工作。 - BLT

Answer 2

我猜你可能会对dplyr的紧凑性感到印象深刻，但是经过许多不必要的计算真的会影响你的时间性能...

> loopfun <- function(df){
+ 
+   event <- (df$event == 100)
+   lasttime <- 0
+ 
+   time <- df$time
+   tae <- rep(0, nrow(df))
+ 
+   for(i in 1:nrow(df)){
+ 
+     if(event[i]){
+ 
+       lasttime <- time[i]
+ 
+     }else{
+ 
+       tae[i] <- time[i] - lasttime
+ 
+     }
+ 
+   }
+ 
+   df$tae <- tae
+ 
+   return(df)
+ }
> 
> dplyrfun <- function(df){
+   
+   return(df %>%
+     mutate(tmp = c(0, diff(time)) * !event,
+            tmp2 = cumsum(c(FALSE, as.logical(diff(event))))) %>%
+     group_by(tmp2) %>%
+     mutate(tae = cumsum(tmp)) %>%
+     select(-tmp, -tmp2)
+   )
+   
+ }
> 
> microbenchmark(loopfun(df), dplyrfun(df), times = 10000)
Unit: microseconds
         expr      min       lq       mean   median       uq      max neval
  loopfun(df)   57.356   70.035   95.89365   82.109   96.599 49001.19 10000
 dplyrfun(df) 1494.564 1625.274 1875.85263 1705.722 1877.336 50087.32 10000

- jtanman

Answer 3

你的 dplyr 实现非常接近了。尝试这个。

df %>%
  arrange(id, time) %>%
  group_by(id) %>%
  mutate(tae = cumsum(event==0)*12)

- keegan

---

谢谢，回答很好。唯一的问题是我的事件不是每天/每周/每月等固定时间间隔分布的。我很抱歉在原始问题中没有表达清楚，并已经修改了上面的示例代码以澄清这一点。 - Entropy

Answer 4

我现在想不出一种向量化的方法，但是这里有一个循环，应该相当快（O(n)）。

event <- (df$event == 100)
lasttime <- 0

time <- df$time
tae <- rep(0, nrow(df))

for(i in 1:nrow(df)){

    if(event[i]){

        lasttime <- time[i]

    }else{

        tae[i] <- time[i] - lasttime

    }

}

df$tae <- tae

- jtanman