Добавление фактической даты последовательно путем итерации для каждой недели

Question

Ниже приведены примеры данных.

structure(list(Starts = structure(c(18064, 18064, 18064, 18064, 
18064, 18064, 18064, 18064, 18064, 18064, 18064, 18064, 18064, 
18064, 18085, 18085, 18085, 18085, 18085, 18085, 18085), class = "Date"), 
    Ends = structure(c(18070, 18070, 18070, 18070, 18070, 18070, 
    18070, 18070, 18070, 18070, 18070, 18070, 18070, 18070, 18091, 
    18091, 18091, 18091, 18091, 18091, 18091), class = "Date"), 
    Day = c("Mon on", "Tue on", "Wed on", "Thu on", "Fri on", 
    "Sat on", "Sun on", "Mon off", "Tue off", "Wed off", "Thu off", 
    "Fri off", "Sat off", "Sun off", "Mon on", "Tue on", "Wed on", 
    "Thu on", "Fri on", "Sat on", "Sun on")), row.names = c(NA, 
-21L), class = c("tbl_df", "tbl", "data.frame"))

Я пытаюсь добавить фактическую дату последовательно для каждой строки, повторяя семь раз (в течение одной недели) на основе даты начала и окончания (недели начинаются сПонедельник и заканчивается воскресеньем). Желаемый результат:

structure(list(Starts = structure(c(18064, 18064, 18064, 18064, 
18064, 18064, 18064, 18064, 18064, 18064, 18064, 18064, 18064, 
18064, 18085, 18085, 18085, 18085, 18085, 18085, 18085), class = "Date"), 
    Ends = structure(c(18070, 18070, 18070, 18070, 18070, 18070, 
    18070, 18070, 18070, 18070, 18070, 18070, 18070, 18070, 18091, 
    18091, 18091, 18091, 18091, 18091, 18091), class = "Date"), 
    Day = c("Mon on", "Tue on", "Wed on", "Thu on", "Fri on", 
    "Sat on", "Sun on", "Mon off", "Tue off", "Wed off", "Thu off", 
    "Fri off", "Sat off", "Sun off", "Mon on", "Tue on", "Wed on", 
    "Thu on", "Fri on", "Sat on", "Sun on"), `Actual Date` = structure(c(18064, 
    18065, 18066, 18067, 18068, 18069, 18070, 18064, 18065, 18066, 
    18067, 18068, 18069, 18070, 18085, 18086, 18087, 18088, 18089, 
    18090, 18091), class = "Date")), row.names = c(NA, -21L), class = c("tbl_df", 
"tbl", "data.frame"))

На основании исследования я понимаю, что мы можем получить фактические даты, используя функцию seq:

date = seq(as.Date("2019-06-17"), as.Date("2019-06-23"), by = "day")

Однако, найдя трудным повторениедень на 7 в кадре данных. Цените вашу поддержку.

Answer 1

Вот идея через базу R,

ddf$new <- unlist(lapply(split(ddf, ddf$Starts), function(i) {
              i1 <- seq(i$Starts[1], i$Ends[1], by = 'day'); 
              as.character(rep(i1, nrow(i) / 7))
              }))

ddf
#       Starts       Ends     Day        new
#1  2019-06-17 2019-06-23  Mon on 2019-06-17
#2  2019-06-17 2019-06-23  Tue on 2019-06-18
#3  2019-06-17 2019-06-23  Wed on 2019-06-19
#4  2019-06-17 2019-06-23  Thu on 2019-06-20
#5  2019-06-17 2019-06-23  Fri on 2019-06-21
#6  2019-06-17 2019-06-23  Sat on 2019-06-22
#7  2019-06-17 2019-06-23  Sun on 2019-06-23
#8  2019-06-17 2019-06-23 Mon off 2019-06-17
#9  2019-06-17 2019-06-23 Tue off 2019-06-18
#10 2019-06-17 2019-06-23 Wed off 2019-06-19
#11 2019-06-17 2019-06-23 Thu off 2019-06-20
#12 2019-06-17 2019-06-23 Fri off 2019-06-21
#13 2019-06-17 2019-06-23 Sat off 2019-06-22
#14 2019-06-17 2019-06-23 Sun off 2019-06-23
#15 2019-07-08 2019-07-14  Mon on 2019-07-08
#16 2019-07-08 2019-07-14  Tue on 2019-07-09
#17 2019-07-08 2019-07-14  Wed on 2019-07-10
#18 2019-07-08 2019-07-14  Thu on 2019-07-11
#19 2019-07-08 2019-07-14  Fri on 2019-07-12
#20 2019-07-08 2019-07-14  Sat on 2019-07-13
#21 2019-07-08 2019-07-14  Sun on 2019-07-14

Answer 2

Используя пакет data.table, вы можете решить его следующим образом:

setDT(dt1)
dt1[, `Actual Date` := .BY[[1]] + rep(0:6, .N/7), by = Starts]
#        Starts       Ends     Day Actual Date
#        <Date>     <Date>  <char>      <Date>    
# 1: 2019-06-17 2019-06-23  Mon on  2019-06-17
# 2: 2019-06-17 2019-06-23  Tue on  2019-06-18
# 3: 2019-06-17 2019-06-23  Wed on  2019-06-19
# 4: 2019-06-17 2019-06-23  Thu on  2019-06-20
# 5: 2019-06-17 2019-06-23  Fri on  2019-06-21
# 6: 2019-06-17 2019-06-23  Sat on  2019-06-22
# 7: 2019-06-17 2019-06-23  Sun on  2019-06-23
# 8: 2019-06-17 2019-06-23 Mon off  2019-06-17
# 9: 2019-06-17 2019-06-23 Tue off  2019-06-18
#10: 2019-06-17 2019-06-23 Wed off  2019-06-19
#11: 2019-06-17 2019-06-23 Thu off  2019-06-20
#12: 2019-06-17 2019-06-23 Fri off  2019-06-21
#13: 2019-06-17 2019-06-23 Sat off  2019-06-22
#14: 2019-06-17 2019-06-23 Sun off  2019-06-23
#15: 2019-07-08 2019-07-14  Mon on  2019-07-08
#16: 2019-07-08 2019-07-14  Tue on  2019-07-09
#17: 2019-07-08 2019-07-14  Wed on  2019-07-10
#18: 2019-07-08 2019-07-14  Thu on  2019-07-11
#19: 2019-07-08 2019-07-14  Fri on  2019-07-12
#20: 2019-07-08 2019-07-14  Sat on  2019-07-13
#21: 2019-07-08 2019-07-14  Sun on  2019-07-14
#        Starts       Ends     Day Actual Date

Answer 3

Один обходной путь будет следующим:

mydata %>%
  mutate(`Actual Date` = Starts + case_when(grepl("Mon", Day) ~ 0,
                                            grepl("Tue", Day) ~ 1,
                                            grepl("Wed", Day) ~ 2,
                                            grepl("Thu", Day) ~ 3,
                                            grepl("Fri", Day) ~ 4,
                                            grepl("Sat", Day) ~ 5,
                                            grepl("Sun", Day) ~ 6)) 


# A tibble: 21 x 4
   Starts     Ends       Day     `Actual Date`
   <date>     <date>     <chr>   <date>       
 1 2019-06-17 2019-06-23 Mon on  2019-06-17   
 2 2019-06-17 2019-06-23 Tue on  2019-06-18   
 3 2019-06-17 2019-06-23 Wed on  2019-06-19   
 4 2019-06-17 2019-06-23 Thu on  2019-06-20   
 5 2019-06-17 2019-06-23 Fri on  2019-06-21   
 6 2019-06-17 2019-06-23 Sat on  2019-06-22   
 7 2019-06-17 2019-06-23 Sun on  2019-06-23   
 8 2019-06-17 2019-06-23 Mon off 2019-06-17   
 9 2019-06-17 2019-06-23 Tue off 2019-06-18   
10 2019-06-17 2019-06-23 Wed off 2019-06-19 

Если вы уверены, что ваши данные в правильном порядке, вы также можете сгруппировать по Starts и сделать следующее:

mydata %>%
  group_by(Starts) %>%
  mutate(`Actual Date` = Starts + 1:n() - 1)