Расчет времени до первой коррекции рулевого управления

Question

У меня есть данные эксперимента по вождению.Прикреплено изображение моего фрейма данных в качестве примера. 1

Пока у меня есть код, который разделяет мой фрейм данных по столбцу идентификатора участника и номера пробной версии, выполняет поиск в столбце угла поворота рулевого колеса (SWA) и выбирает первую строку, в которой происходит рулевое управление.угол выше порога мертвой зоны и сохраняет его в новом фрейме данных - по одному на каждое испытание:

pilot_clean_new <- lapply(split(pilot_clean, list(pilot_clean$ppid, pilot_clean$trialn), drop = TRUE), function(data) {

i <- data[abs(data$SWA) > 0.01,] # find all observations that exceed threshold

if (nrow(i)==0) return(NULL) # handle cases where no observations meet critera

return(i[1,]) # return only the first match
})

pilot_clean_new <- do.call(rbind.data.frame, pilot_clean_new)
pilot_clean_new <- arrange(pilot_clean_new, ppid)

Однако, как вы можете видеть из этого изображения pilot_clean_new 2

Моя отметка времени была непрерывной.Таким образом, у меня есть метка времени для каждого испытания, чтобы угол поворота рулевого колеса был выше порога.Что мне нужно, это вычесть эту временную метку из первой временной метки каждого пробного номера, чтобы каждый участник получил «истекшее время», когда угол поворота рулевого колеса был выше порога.

Есть ли у кого-нибудь какие-либо предположения о том, как этобыло бы возможно?Моя идея состояла в том, чтобы использовать исходный набор данных и с некоторой формой цикла выбрать первую временную метку каждого испытания с помощью head () и вычесть ее из моих текущих временных меток в чистом кадре данных.

Answer 1

Я сгенерировал примерный набор данных, который, по моему мнению, должен воспроизвести необходимые условия.Пожалуйста, сообщите, если не так.

Я использовал dplyr для выполнения большинства функций:

# load required libraries
library(magrittr)
library(dplyr)

# generate sample data
pilot_clean <- 
    base::data.frame(
        ppid = base::c(base::rep(1,15), base::rep(2,15), base::rep(3,15))
        , trialn = base::c(base::rep(1:3,15))
        , SWA = base::sample(base::seq(0.00,0.02, by = .001), 45, replace = T)
    ) %>% 
    dplyr::arrange(ppid,trialn) %>% 
    dplyr::mutate(timestamp = base::sort(stats::runif(45,min=5, max=125)))

# set threshold
SWA_threshold = 0.01

# force null condition
pilot_clean[pilot_clean$ppid == 3 & pilot_clean$trialn == 3,"SWA"] <- SWA_threshold - .001

# determine first time in each ppid, trialn group
pilot_clean_first_time <-
    pilot_clean %>% 
    dplyr::group_by(ppid,trialn) %>% 
    dplyr::filter(dplyr::row_number() == 1) %>% 
    dplyr::ungroup()  %>% 
    dplyr::transmute(ppid, trialn, first_timestamp = timestamp) #use transmute to rename for future join, ungroup first to allow for column rename of grouping variable

# determine first time in each ppid, trialn group above threshold
pilot_clean_first_time_above_threshold <-
    pilot_clean %>%
    dplyr::group_by(ppid,trialn) %>% 
    dplyr::filter(SWA > SWA_threshold) %>% 
    dplyr::filter(dplyr::row_number() == 1) %>% 
    dplyr::ungroup() %>% 
    dplyr::transmute(ppid, trialn, first_timestamp_above_threshold = timestamp) #use transmute to rename for future join, ungroup first to allow for column rename of grouping variable

# get unique list of ppid and trialn (to enable left join and null condition)
pilot_ppid_trial_list <- 
    pilot_clean %>% 
    dplyr::select(ppid,trialn) %>% 
    unique()

# produce final result set with ppid, trialn, first time, and first time above threshold
pilot_clean_new <-
    pilot_ppid_trial_list %>% 
    dplyr::left_join(pilot_clean_first_time) %>% 
    dplyr::left_join(pilot_clean_first_time_above_threshold) %>%
    dplyr::mutate(adjusted_first_timestamp_above_threshold = first_timestamp_above_threshold - first_timestamp) # calculate final result