Преобразуйте «данные начала и остановки» (также называемые кодами поворота) в длинный формат (также называемый временными кодами) с помощью dplyr. - PullRequest
1 голос
/ 30 сентября 2019

Я хочу преобразовать коды поворотов, подобные этим

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)  

1 Ответ

1 голос
/ 30 сентября 2019

В одну сторону, используя tidyverse и cSplit_e из splitstackshape. Мы создаем последовательность между start и end для каждой секунды, group_by каждую секунду и преобразуем ее в разделенное запятыми значение, а затем используем cSplit_e для преобразования их в двоичные столбцы.

library(tidyverse)

turndata_wide %>%
  mutate(time = map2(start, end, seq, by = "1 sec")) %>%
  unnest(cols = time) %>%
  select(-start, -end) %>%
  group_by(time) %>%
  summarise(code = toString(code)) %>%
  splitstackshape::cSplit_e("code", type = "character", drop = TRUE)

который возвращает вывод в виде:

#                  time code_a code_b code_g
#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
#11 2019-05-25 00:00:11      1     NA      1
#12 2019-05-25 00:00:12      1     NA      1
#13 2019-05-25 00:00:13      1     NA      1
#14 2019-05-25 00:00:14      1     NA      1
#15 2019-05-25 00:00:15      1     NA      1
#16 2019-05-25 00:00:16     NA     NA      1
#17 2019-05-25 00:00:17     NA     NA      1
#18 2019-05-25 00:00:18     NA     NA      1
#19 2019-05-25 00:00:19     NA     NA      1
#20 2019-05-25 00:00:20     NA     NA      1
#21 2019-05-25 00:00:21     NA     NA      1
#22 2019-05-25 00:00:22     NA     NA      1
#23 2019-05-25 00:00:23     NA     NA      1
#24 2019-05-25 00:00:24     NA     NA      1
#25 2019-05-25 00:00:25     NA     NA      1
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...