Get month to which a calendar week belongs (calculated by mode)

get_month_from_isoweek.R

#' Get the month (or all days) of a calendar week
#'
#' @param week Atomic character vector. Specify the calendar week you want \cr
#' to have parsed. Must be of format 'YYYY-WW' (e.g., '2020-03').
#' @param .df Logical. Defaults to FALSE. If TRUE, the function does not \cr
#' return a single integer vector with the month information but a \cr
#' data.frame with all days and dates of the chosen calendar week, including \cr
#' information on which month each day belongs to. 
#'
#' @return Atomic integer vector containing the month to which the calendar week \cr
#' belongs or (if .df = TRUE) a data.frame with all the days and dates in the \cr
#' week. If .df = FALSE, the function returns the month to which the majority of \cr
#' the days in the specified calendar week belongs (computed as the mode).
#' 
create_isoweek <- function(week, 
                           .df = FALSE) {
  
  if(missing(week)) stop("You have to specify a 'week' parameter in format 'YYYY-WW'.", call. = FALSE)
  if(!grepl("-", week)) stop("'week' has to be of format 'YYYY-WW'.", call. = FALSE)
  if(nchar(week) != 7) stop("'week' has to be of format 'YYYY-WW'.", call. = FALSE)
  if(!is.character(week)) stop("'week' has to be a character string.")

  if(isFALSE(str_detect(week,
                        pattern = "[:digit:][:digit:][:digit:][:digit:]-[:digit:][:digit:]"))) {
    stop("'week' has to be of format 'YYYY-WW'.")
  }
  
  # Define a function to calculate mode
  get_mode <- function(x) {                     
    unique_x <- unique(x)
    tabulate_x <- tabulate(match(x, unique_x))
    unique_x[tabulate_x == max(tabulate_x)]
  }
  
  ## Parse the input to match format required by {isoWeek}
  weeknr <- stringi::stri_sub(week, 6, 7) %>% as.numeric()
  
  week_start <- week %>% 
    stringi::stri_sub_replace(., 
                              from = 6, 
                              to = 5, 
                              replacement = "W") %>% 
    paste0(., "-1")
  
  week_end <- week %>% 
    stringi::stri_sub_replace(., 
                              from = 6, 
                              to = 5, 
                              replacement = "W") %>% 
    paste0(., "-7")
  
  # Create vector with days of each calendar week
  week_long <- lubridate::as_date(
    ISOweek::ISOweek2date(week_start):ISOweek::ISOweek2date(week_end)
    )
  
  # Create tibble that contains the extented information
  result_df <- tibble::tibble(date = week_long,
                              year = lubridate::year(as_date(date)),
                              month = lubridate::month(as_date(date)),
                              weeknr = weeknr, 
                              isoweek = week)
  
  # Calculate month of calendar week based on mode  
  vector <- result_df %>% dplyr::group_by(isoweek) %>% 
    dplyr::summarise(month = get_mode(month)) %>% 
    dplyr::select(-isoweek) %>% 
    as.vector()
  
  # Return results
  if (isTRUE(.df)) { 
    
    return(result_df)
    
  } else { 
      
    return(vector$month)
    
  }
  
}