Я хочу преобразовать коды поворотов, подобные этим
library(tidyverse)
library(lubridate)
turndata_wide <- tibble(turnID = 1:4,
code = c("a", "b", "a", "g"),
start = c(ymd_hms("2019_05_25 00:00:05"),
ymd_hms("2019_05_25 00:00:02"),
ymd_hms("2019_05_25 00:00:10"),
ymd_hms("2019_05_25 00:00:01")),
end = c(ymd_hms("2019_05_25 00:00:08"),
ymd_hms("2019_05_25 00:00:07"),
ymd_hms("2019_05_25 00:00:15"),
ymd_hms("2019_05_25 00:00:25")))
, в результате чего
> turndata_wide
# A tibble: 4 x 4
turnID code start end
<int> <chr> <dttm> <dttm>
1 1 a 2019-05-25 00:00:05 2019-05-25 00:00:08
2 2 b 2019-05-25 00:00:02 2019-05-25 00:00:07
3 3 a 2019-05-25 00:00:10 2019-05-25 00:00:15
4 4 g 2019-05-25 00:00:01 2019-05-25 00:00:25
, в то, что мы (социологи) называем временными кодами. Это должно выглядеть так:
# A tibble: 25 x 4
time a b g
<dttm> <dbl> <dbl> <dbl>
1 2019-05-25 00:00:01 NA NA 1
2 2019-05-25 00:00:02 NA 1 1
3 2019-05-25 00:00:03 NA 1 1
4 2019-05-25 00:00:04 NA 1 1
5 2019-05-25 00:00:05 1 1 1
6 2019-05-25 00:00:06 1 1 1
7 2019-05-25 00:00:07 1 1 1
8 2019-05-25 00:00:08 1 NA 1
9 2019-05-25 00:00:09 NA NA 1
10 2019-05-25 00:00:10 1 NA 1
# … with 15 more rows
Я построил (пешеходное и безобразное) решение, которое работает, но я совершенно уверен, что есть гораздо более лучшее решение. Мой (безобразный) подход:
- Создание long_df за ход
- Присоединение к df с "строками полного времени" за ход
- Присоединение к тезисам full_dfs за ход
- Распространение кодов
## Loop over steps 1) + 2) ########################################
df_per_turn_list <- list()
for(i in 1:nrow(turndata_wide)){
data_turn_temp <- turndata_wide[i,]%>%
gather(startend, time, start, end)%>%
full_join(.,
tibble(time = seq.POSIXt(from = min(.$time),
to = max(.$time),
by = "sec"),
code = .$code[1],
turnID = .$turnID[1]))%>%
select(-startend)%>%
arrange(time)
temp_name <- paste("data_turn_", i, sep = "")
df_per_turn_list[[temp_name]] <- data_turn_temp
}
## Steps 3) + 4): Join dfs_per turn and spread codes ########
reduce(df_per_turn_list, full_join)%>%
mutate(dummy_one = 1)%>%
select(-turnID)%>%
spread(code, dummy_one)%>%
arrange(time)