计算自上次事件以来经过的时间答案

【问题标题】：Calculate elapsed time since last event计算自上次事件以来经过的时间
【发布时间】：2014-12-20 15:06:02
【问题描述】：

我有一个包含多个主题 (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 [最后一个事件之后的时间]），这样理想的输出将如下所示：

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

显然，这些都没有产生我想要的输出。似乎 R 不能很好地容忍在 ifelse 函数中分配变量。我对 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

【问题讨论】：

标签： r if-statement time dplyr

【解决方案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

【讨论】：

太棒了！你认为有可能调整这段代码来计算下一个事件的时间吗？
+1 这个非常好的解决方案。如果你想同时删除临时变量tmp2，你应该在select(-tmp, -tmp2)之前插入ungroup()
谢谢——我很抱歉没有早点意识到这一点，但是如果 ID 中的间隔发生变化，rev(cumsum(...)) 函数将无法产生正确的结果。请参阅我在上面帖子中的编辑以获取可重现的示例。
在这两个例子中，在时间 = 0 时，有一个事件。当我运行这段代码时，tae 在第一个事件发生之前给出了奇怪的行结果。同样，在您的示例中，最后一行有一个事件；当最后一行没有事件时，tbe 似乎不起作用。

【解决方案2】：

您的dplyr 实现非常接近。试试这个

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

【讨论】：

谢谢，很好的回答。唯一的麻烦是我的事件不是一致地分布在 XX hrs/dys/wks 之间。对于在原始问题中没有明确说明这一点，我深表歉意，并修改了上面的示例代码以明确这一点。

【解决方案3】：

我猜你可能会对 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

【讨论】：

【解决方案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

【讨论】：