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

时间:2014-10-24 18:00:52

标签: r if-statement time dplyr

我有一个包含多个主题(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中,我尝试了ifelsedplyr解决方案。但是,两者都不能产生我想要的输出。

# 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之前的时间的变量。如果有人碰巧考虑如何最好地进行这个(也许是更棘手的)计算,请随时分享。

任何有关如何获得这些工作(或替代解决方案)的想法将不胜感激。谢谢!

P.S。 - 事件之间的间隔在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

4 个答案:

答案 0 :(得分:8)

这是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 :(得分:1)

您与dplyr实施非常接近。试试这个

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

答案 2 :(得分:1)

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

答案 3 :(得分:0)

我现在无法想出一种对其进行矢量化的方法,但这里的循环应该非常快(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