Tidyverse способ вырастить набор данных

Question

Я пытаюсь понять подход tidyverse к проблемам, когда вы обычно увеличиваете длину набора данных. A group_by + mutate не будет работать с этими типами проблем, потому что число строк не равно.

Ниже приведен пример набора данных и времени, когда я хочу получить последовательность дат между начальной и конечной датой. Я показываю, как это сделать не аккуратно. Как я могу сделать это с tidyverse?

dat <- structure(list(id = c("01", "02", "03", "04", "05", "06", "07", 
"08", "09", "10"), race = structure(c(1L, 1L, 1L, 1L, 3L, 1L, 
1L, 1L, 2L, 1L), .Label = c("White", "Hispanic", "Black", "Asian", 
"Bi-Racial", "Native", "Other", "Hawaiian"), class = "factor"), 
    installdate = structure(c(17683, 17713, 17713, 17744, 17744, 
    17744, 17805, 17836, 17836, 17897), class = "Date"), usageenddate = structure(c(17758, 
    17759, 17726, 17809, 17773, 17777, 17821, 17863, 17899, 17964
    ), class = "Date")), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -10L))

##    id    race     installdate usageenddate
##    <chr> <fct>    <date>      <date>      
##  1 01    White    2018-06-01  2018-08-15  
##  2 02    White    2018-07-01  2018-08-16  
##  3 03    White    2018-07-01  2018-07-14  
##  4 04    White    2018-08-01  2018-10-05  
##  5 05    Black    2018-08-01  2018-08-30  
##  6 06    White    2018-08-01  2018-09-03  
##  7 07    White    2018-10-01  2018-10-17  
##  8 08    White    2018-11-01  2018-11-28  
##  9 09    Hispanic 2018-11-01  2019-01-03  
## 10 10    White    2019-01-01  2019-03-09  

library(tidyverse)

dat2 <- dat %>%
    group_by(id) %>%
    mutate(
        weeks2 = length(seq.Date(installdate, usageenddate, by = 'weeks'))
    )

dat2[rep(seq_len(nrow(dat2)), dat2$weeks2),] %>%
    group_by(id) %>%
    mutate(
        weeks = as.Date(cut(seq.Date(installdate[1], usageenddate[1], by = 'weeks'), 'week'))
    ) %>%
    select(id, race, weeks)


    ##    id    race  weeks     
    ##    <chr> <fct> <date>    
    ##  1 01    White 2018-05-28
    ##  2 01    White 2018-06-04
    ##  3 01    White 2018-06-11
    ##  4 01    White 2018-06-18
    ##  5 01    White 2018-06-25
    ##  6 01    White 2018-07-02
    ##  7 01    White 2018-07-09
    ##  8 01    White 2018-07-16
    ##  9 01    White 2018-07-23
    ## 10 01    White 2018-07-30
    ## # ... with 57 more rows

Answer 1

Если нам нужен один %>%, тогда используйте uncount

library(tidyverse)
dat %>%
   group_by(id) %>%
   mutate(
    weeks2 = length(seq.Date(installdate, usageenddate, by = 'weeks'))
 ) %>% 
    uncount(weeks2) %>% 
    group_by(id) %>% 
    mutate(
     weeks = as.Date(cut(seq.Date(installdate[1], 
              usageenddate[1], by = 'weeks'), 'week'))
 ) %>% 
    select(id, race, weeks)
# A tibble: 67 x 3
# Groups:   id [10]
#   id    race  weeks     
#   <chr> <fct> <date>    
# 1 01    White 2018-05-28
# 2 01    White 2018-06-04
# 3 01    White 2018-06-11
# 4 01    White 2018-06-18
# 5 01    White 2018-06-25
# 6 01    White 2018-07-02
# 7 01    White 2018-07-09
# 8 01    White 2018-07-16
# 9 01    White 2018-07-23
#10 01    White 2018-07-30
# … with 57 more rows

---

Или вместо создания промежуточного шага для расширения строк (обратите внимание, в предыдущем случае мы делаем seq два раза - 1), чтобы получить length, а затем снова для шага cut), после группировки по 'id' используйте map2 для циклического перебора соответствующих элементов 'installdate', usenddate ', получите seq, cut it за' week ', конвертируйте в Date

dat %>% 
   group_by(id) %>%
   mutate(weeks = map2(installdate, usageenddate, ~ 
      seq(.x, .y, by = 'weeks') %>% 
        cut('week') %>%
        as.Date)) %>% 
   select(id, race, weeks) %>% 
   unnest
# A tibble: 67 x 3
# Groups:   id [10]
#   id    race  weeks     
#   <chr> <fct> <date>    
# 1 01    White 2018-05-28
# 2 01    White 2018-06-04
# 3 01    White 2018-06-11
# 4 01    White 2018-06-18
# 5 01    White 2018-06-25
# 6 01    White 2018-07-02
# 7 01    White 2018-07-09
# 8 01    White 2018-07-16
# 9 01    White 2018-07-23
#10 01    White 2018-07-30
# … with 57 more rows