我有一个包含多个主题(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
之前的时间的变量。如果有人碰巧考虑如何最好地进行这个(也许是更棘手的)计算,请随时分享。
任何有关如何获得这些工作(或替代解决方案)的想法将不胜感激。谢谢!
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
答案 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