I want to model whether I can respond to an event. This depends on when I last responded to an event. I need to take these conditions into account:
- Events can occur throughout the day, but I can only respond between 7 am and 11pm.
- Time between events can vary, but time between responses must be at least 90 min. In other words, you can only respond to a new event if your last response was at least 90 min ago. It is important, that I don’t want a 1 if the time between events is >90 but I only want a 1 if the time between an event and last response is >90.
structure(list(event_day = c(0L, 0L, 0L, 0L, 0L, 0L), event_hr = c(1,
8, 9, 9, 10, 12), event_minute = c(41L, 25L, 22L, 41L, 26L, 1L
), onset_time = c(101, 505, 562, 581, 626, 721)), row.names = c(NA,
-6L), class = c("tbl_df", "tbl", "data.frame"))
Onset_time is the time since start of the model in minutes. We would like to have a “respond_col” with 1 when we can respond and 0 when we cannot respond. For these 6 rows, the respond_col is supposed to result in 0,1,0,0,1,1. This sums up what I want to do but I don’t know how to code this: If difference in onset_time>90 since last 1 in respond_col, print 1 in respond_col, else print 0 in respond_col.
Hope you can help me!
CodePudding user response：
This requires a few data modifications and a for statement.
This requires 2 libraries, hms and tidyverse.
I added rows to your data frame to test some of the conditions you mentioned.
library(hms)
library(tidyverse)
dat <- read.table(header = T, text = "
event_day event_hr event_minute onset_time
1 0 1 41 101
2 0 8 25 505
3 0 9 22 562
4 0 9 41 581
5 0 10 26 626
6 0 12 1 721")
# add rows for testing
dat <- do.call("rbind",
list(dat, c(0, 12, 59, 721 58),
c(0, 14, 20, 721 58 21 60),
c(0, 23, 5, 860 45 8 * 60),
c(1, 7, 5, 860 45 16 * 60))) %>% as.data.frame()
# event_day event_hr event_minute onset_time
# 1 0 1 41 101
# 2 0 8 25 505
# 3 0 9 22 562
# 4 0 9 41 581
# 5 0 10 26 626
# 6 0 12 1 721
# 7 0 12 59 779
# 8 0 14 20 860
# 9 0 23 0 1380
# 10 1 7 5 1865
The next step requires a vector that stores the time thresholds (7-11) and the following changes to dat: a column with the time differences, a field that indicates whether or not the time meets the 7 am - 11 pm criteria, and 2 columns filled with 0: accumulated time and response. Both of these columns are filled in the for statement. The function hms is from the library hms.
these <- c(hms(0, 0, 7), hms(0, 0, 23)) # day constraints
(dat1 <- dat %>% mutate(
time = c(0, diff(onset_time)), # 0 for first row, then the rest
time_avail = between(hms(hours = event_hr, minutes = event_minute),
these[1], these[2]),
# accumulated time since last reset; whether response is warranted (conditions met)
accum_time = 0, response = 0))
# event_day event_hr event_minute onset_time time time_avail accum_time response
# 1 0 1 41 101 0 FALSE 0 0
# 2 0 8 25 505 404 TRUE 0 0
# 3 0 9 22 562 57 TRUE 0 0
# 4 0 9 41 581 19 TRUE 0 0
# 5 0 10 26 626 45 TRUE 0 0
# 6 0 12 1 721 95 TRUE 0 0
# 7 0 12 59 779 58 TRUE 0 0
# 8 0 14 20 860 81 TRUE 0 0
# 9 0 23 5 1385 525 FALSE 0 0
# 10 1 7 5 1865 480 TRUE 0 0
For the for statement, I'm using a boolean flag: reset for when the cumulative time resets.
reset = F # boolean flag for cumulative time
for(j in 1:nrow(dat1)) {
if(j == 1 | reset) { # first row or reset
dat1$accum_time[j] <- dat1$time[j]
reset = F
} else { # any row other than first or reset
dat1$accum_time[j] <- dat1$accum_time[j - 1] dat1$time[j]
} # determine whether trigger the reset
if(dat1$accum_time[j] > 90 & dat1$time_avail[j]) {
dat1$response[j] <- 1
reset = T
}
}
dat1
# event_day event_hr event_minute onset_time time time_avail accum_time response
# 1 0 1 41 101 0 FALSE 0 0
# 2 0 8 25 505 404 TRUE 404 1
# 3 0 9 22 562 57 TRUE 57 0
# 4 0 9 41 581 19 TRUE 76 0
# 5 0 10 26 626 45 TRUE 121 1
# 6 0 12 1 721 95 TRUE 95 1
# 7 0 12 59 779 58 TRUE 58 0
# 8 0 14 20 860 81 TRUE 139 1
# 9 0 23 5 1385 525 FALSE 525 0
# 10 1 7 5 1865 480 TRUE 1005 1
Let me know if you have any questions.