calc-rolling-week.R

#' Calculates rolling weeks backward from the end_date.
#' 
#' The purpose is to group a vector of dates into 7 day weeks
#' backward in time. For example, if the end date was 2020-06-09, 
#' the days 2020-06-03 through 2020-06-09 would be one week,
#' 2020-05-27 through 2020-06-02 would be another week, 2020-05-20
#' through 2020-05-26 another and so on. The function will work even
#' if the vector of dates is missing one or more dates in the series.
#'
#' @param date_vector the vector of dates to group into weeks. Must be
#'                    in Date format or something that can be coerced to
#'                    Date by \code{\link[base]{as.Date}}.
#' @param end_date the day on which to start counting backwards. Defaults to
#'                 the current date, i.e. \code{\link[base]{Sys.Date}}.
#'
#' @return a vector of weeks counting backward in time. The current week is 
#'         numbered 1, the previous is numbered 2, etc. The week farthest in 
#'         the past will currently return NA values so that you would mistakenly 
#'         aggregate a week that may not be the full 7 days.
#'
#' @examples
#' #General
#' date_vector1 <- seq.Date(from = as.Date("2020-01-01"), to = as.Date("2020-06-09"), by = 1)
#' data.frame(date = date_vector1,
#'            weeknum = rolling_week(date_vector = date_vector1, 
#'                                   end_date = as.Date(Sys.Date())))
#'
#' #In a tidyverse pipe
#' tibble(tv_date = date_vector1) %>% 
#'   mutate(
#'     tv_weeknum = rolling_week(tv_date, end_Date = as.Date(Sys.Date()))
#'   )
rolling_week <- function(date_vector, end_date = as.Date(Sys.Date())){
  #Coerce to dates 
  date_vector <- as.Date(date_vector)
  end_date = as.Date(end_date)
  
  min_date <- min(date_vector)
  
  period_length <- as.numeric(difftime(end_date, min_date))
  period_weeks <- floor(period_length / 7)
  
  week_ends <-  c(end_date + lubridate::days(1), end_date - lubridate::weeks(1:period_weeks))
  
  out <- period_weeks - cut(date_vector, breaks = week_ends, include_lowest = TRUE, right = TRUE, label = FALSE) + 1
  
  return(out)
}

#Test it out
library(tidyverse)

date_vector1 <- seq.Date(from = as.Date("2020-01-01"), to = as.Date("2020-06-09"), by = 1)
date_vector2 <- sample(date_vector1, 78, replace = FALSE)

vec_consec <- tibble(my_date = date_vector1) %>% 
  mutate(
    week_consec = rolling_week(my_date, end_date = "2020-06-09")
  )

vec_miss <- tibble(my_date = date_vector2) %>% 
  mutate(
    week_miss = rolling_week(my_date, end_date = "2020-06-09"),
    observed = 1
  )

combined <- left_join(vec_consec, vec_miss, by = "my_date")

#Appears to work correctly.
table(Observed = !is.na(combined$observed), 
      "Complete Vector = NA" = is.na(combined$week_consec), 
      "Missing Vector = NA" = is.na(combined$week_miss)) %>% ftable

table(combined$week_consec[combined$observed == 1] == combined$week_miss[combined$observed == 1] | (is.na(combined$week_consec[combined$observed == 1]) & is.na(combined$week_miss[combined$observed == 1])))


observed <- combined %>% 
  filter(observed == 1) 

identical(observed$week_consec, observed$week_miss)