Блог

Я создал вектор дат с 2015-11-29 по 2020-09-05 согласно:

 newdates_startweek <- seq(as.Date('2015-11-29'),as.Date('2020-09-05'),by = 7)
  

Теперь я хочу объединить этот ‘newdates_startweek’ с моим исходным набором данных:

 region   id      name        date       appointment
   A      1    clinic1    2015-11-29        1      
   A      1    clinic1    2015-12-08        1      
   A      1    clinic1    2020-08-17        1      
   A      1    clinic1    2020-08-19        1      
   A      1    clinic1    2020-09-03        1      
  

код исходного набора данных:

 region <- c("A","A","A","A", "A")
id <- c(1,1,1,1,1)
name <- c("clinic1","clinic1","clinic1","clinic1","clinic1")
date <- c(as.Date('2015-11-29'), as.Date("2015-12-08"), as.Date("2020-08-17"), as.Date('2020-08-19'), as.Date('2020-09-03'))
appointment <- c(1,1,1,1,1)

df <- data.frame(region, id, name, date, appointment)
  

Чтобы получить это:

 region   id      name        date       appointment   newdates_startweek
   A      1    clinic1    2015-11-29        1         2015-11-29
   A      1    clinic1    2015-12-08        1         2015-12-06
   A      1    clinic1        NA            0         2015-12-13
   A      1    clinic1        NA            0         2015-12-20
   A      1    clinic1        NA            0         2015-12-27
   A      1    clinic1        NA            0         2016-01-03
                                ....
   A      1    clinic1    2020-08-17        1         2020-08-16
   A      1    clinic1    2020-08-19        1         2020-08-16
   A      1    clinic1        NA            0         2020-08-23
   A      1    clinic1    2020-09-03        1         2020-08-30
  

Знаете ли вы быстрый способ сделать это?

Итак, мое решение немного затянуто. Я переработал некоторый код, который у меня был, и попытался подумать о том, как это будет работать, если вы захотите сделать это для нескольких наборов (регион, идентификатор, имя). Это data.table решение, но я преобразовал выходные данные обратно в df.

 library(data.table)
library(optiRum)
library(lubridate)
library(dplyr)

# a function in my tool kit :)
getWeek <- function(dates, weekday_start="Sunday"){
  lookup <- data.table(id=1:7, day=as.character(lubridate::wday(1:7, label = TRUE, abbr = FALSE)))
  # its -1 for some reason in floor date
  weeks <- floor_date(dates, "week", 
                      week_start = lookup[day==weekday_start, id]-1)
  return(weeks)
}

# test it, should go back to sunday
week_start <- weekdays(newdates_startweek[1])
getWeek(as.Date("2015-11-30"), week_start)

# so find the starting week for each date, using data.tables
dt <- as.data.table(df)
dt[, week := getWeek(date, week_start)]

# I've used optiRum::CJ.dt for making all combinations of the id data in id_sets[]
# and the string of weeks. It's like expand.grid but quicker and more versatile
id_sets <- as.data.table(unique(df[,  c("region", "id", "name")]))
expand_dt <- optiRum::CJ.dt(data.table(week = newdates_startweek), id_sets)

# dplyr::anti_join removes data already existing in dt
expand_dt <- setDT(anti_join(expand_dt, dt, by=c("region", "id", "name", "week")))

# now they can be bound together. rbindlist has a fill option to add NA's for me
out <- rbindlist(list(dt, expand_dt), fill=TRUE) 

# order by week and date
setorder(out, week, date)
out_df <- as.data.frame(out)
out_df
  

Отвечает ли это:

 > df %>% mutate(date = as.character(date)) %>% right_join(as.data.frame(as.character(newdates_startweek)) %>% setNames('newdates_startweek'), by = c('date' ='newdates_startweek' ), keep = 1) 
    region id    name       date appointment newdates_startweek
1        A  1 clinic1 2015-11-29           1         2015-11-29
2     <NA> NA    <NA>       <NA>          NA         2015-12-06
3     <NA> NA    <NA>       <NA>          NA         2015-12-13
4     <NA> NA    <NA>       <NA>          NA         2015-12-20
5     <NA> NA    <NA>       <NA>          NA         2015-12-27
6     <NA> NA    <NA>       <NA>          NA         2016-01-03
..
..
  

Возможно, попробуйте

 library(dplyr)
library(tidyr)
library(lubridate)

df %>% 
  mutate(newdates_startweek = floor_date(date, "week", 7)) %>% 
  complete(region, id, name, newdates_startweek = full_seq(newdates_startweek, 7), fill = list(appointment = 0))
  

Вывод

 # A tibble: 250 x 6
   region    id name    newdates_startweek date       appointment
   <chr>  <dbl> <chr>   <date>             <date>           <dbl>
 1 A          1 clinic1 2015-11-29         2015-11-29           1
 2 A          1 clinic1 2015-12-06         2015-12-08           1
 3 A          1 clinic1 2015-12-13         NA                   0
 4 A          1 clinic1 2015-12-20         NA                   0
 5 A          1 clinic1 2015-12-27         NA                   0
 6 A          1 clinic1 2016-01-03         NA                   0
 7 A          1 clinic1 2016-01-10         NA                   0
 8 A          1 clinic1 2016-01-17         NA                   0
 9 A          1 clinic1 2016-01-24         NA                   0
10 A          1 clinic1 2016-01-31         NA                   0
# ... with 240 more rows