R/date_functions.R

In BillyEhrenberg/FTutilityfuncs:

#' A function to convert an excel date read in as a number to an R date object
#'
#' Converts the number of secs since 1899-12-30 to a R-readable date
#' @param date_as_number a number representing the number of secs since 1899-12-30
#' @export
#' @examples
#' fromExcelDate()


fromExcelDate <- function(date_as_number){
  as.Date(as.numeric(date_as_number), origin="1899-12-30")
}


#' A function to convert a quarter (format Q1 1987 or 1987 Q1) to a date.
#'
#' Converts a quarter (format Q1 1987 or 1987 Q1) to a date
#' @param year_and_quarter a string, format Q1 1987 or 1987 Q1
#' @param q1_month an integer or string can be 1 or 3, defaults to Q1 being the first of march (q1_month = 3)
#' @export
#' @examples
#' quarter_to_date()


quarter_to_date <- function(year_and_quarter, q1_month = 3){

  if(!q1_month %in% c(1,3)){
    error('please choose 1 or 3 as starting month')
  } else {

    year <- stringr::str_extract(year_and_quarter,'[0-9]{4}')
    quarter <- stringr::str_extract(year_and_quarter,'Q[0-9]|q[0-9]') %>%
      readr::parse_number

    day <- '01'
    month <- (quarter * as.integer(q1_month))%>%
      stringr::str_pad(2,'left',0)
    date <- paste(day,month,year, sep = '-') %>%
      lubridate::dmy(.)

    return(date)

  }
}


#' A function to round a date to it's nearest quarter
#'
#' Rounds an R date object to its nearest quarter
#' @param date a date object
#' @param q1_month an integer or string can be 1 or 3, defaults to Q1 being the first of march (q1_month = 3)
#' @export
#' @examples
#' date_to_quarter_as_date()

date_to_quarter_as_date <- function(date, q1_month = 3){


  if(!q1_month %in% c(1,3)){
    error('please choose 1 or 3 as starting month')
  } else {

  year <- lubridate::year(date)

  month <- lubridate::month(date)

  quarters <- seq(as.integer(q1_month), 12, 3) %>%
    stringr::str_pad(2,'left','0')

  quarter <- quarters[ceiling(month/3)] %>%
    paste('01',.,year,sep = "/")

  return(quarter)

  }


}