Nothing
#' @title Assign a date to a quarter
#'
#' @description
#'
#' The qtr functions take a date input and calculate the relevant
#' quarter-related value from it. They all return the year as part of this
#' value.
#'
#' \itemize{
#' \item `qtr` returns the current quarter
#'
#' \item `qtr_end` returns the last month in the quarter
#'
#' \item `qtr_next` returns the next quarter
#'
#' \item `qtr_prev` returns the previous quarter
#' }
#'
#' @details Quarters are defined as:
#'
#' \itemize{
#' \item January to March (Jan-Mar)
#' \item April to June (Apr-Jun)
#' \item July to September (Jul-Sep)
#' \item October to December (Oct-Dec)
#' }
#'
#' @param date A date which must be supplied with `Date` or `POSIXct`
#' @param format A `character` string specifying the format the quarter
#' should be displayed in. Valid options are `long` (January to March 2018) and
#' `short` (Jan-Mar 2018). The default is `long`.
#'
#' @return A character vector of financial quarters in the specified format.
#'
#' @examples
#' x <- lubridate::dmy(c(26032012, 04052012, 23092012))
#' qtr(x)
#' qtr_end(x, format = "short")
#' qtr_next(x)
#' qtr_prev(x, format = "short")
#'
#' @export
#' @rdname qtr
qtr <- function(date, format = c("long", "short")) {
format <- match.arg(format)
if (!inherits(date, c("Date", "POSIXct"))) {
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
}
quarter_num <- lubridate::quarter(date)
if (format == "long") {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"January to March ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"April to June ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"July to September ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"October to December ",
lubridate::year(date)
)
))
} else {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"Jan-Mar ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"Apr-Jun ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"Jul-Sep ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"Oct-Dec ",
lubridate::year(date)
)
))
}
}
#' @export
#' @rdname qtr
qtr_end <- function(date, format = c("long", "short")) {
format <- match.arg(format)
if (!inherits(date, c("Date", "POSIXct"))) {
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
}
quarter_num <- lubridate::quarter(date)
if (format == "long") {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"March ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"June ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"September ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"December ",
lubridate::year(date)
)
))
} else {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"Mar ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"Jun ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"Sep ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"Dec ",
lubridate::year(date)
)
))
}
}
#' @export
#' @rdname qtr
qtr_next <- function(date, format = c("long", "short")) {
format <- match.arg(format)
if (!inherits(date, c("Date", "POSIXct"))) {
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
}
quarter_num <- lubridate::quarter(date)
if (format == "long") {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"April to June ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"July to September ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"October to December ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"January to March ",
lubridate::year(date) + 1
)
))
} else {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"Apr-Jun ",
lubridate::year(date)
),
quarter_num == 2 ~ paste0(
"Jul-Sep ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"Oct-Dec ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"Jan-Mar ",
lubridate::year(date) + 1
)
))
}
}
#' @export
#' @rdname qtr
qtr_prev <- function(date, format = c("long", "short")) {
format <- match.arg(format)
if (!inherits(date, c("Date", "POSIXct"))) {
cli::cli_abort("{.arg date} must be a {.cls Date} or {.cls POSIXct} vector, not a {.cls {class(date)}} vector.")
}
quarter_num <- lubridate::quarter(date)
if (format == "long") {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"October to December ",
lubridate::year(date) - 1
),
quarter_num == 2 ~ paste0(
"January to March ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"April to June ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"July to September ",
lubridate::year(date)
)
))
} else {
return(dplyr::case_when(
quarter_num == 1 ~ paste0(
"Oct-Dec ",
lubridate::year(date) - 1
),
quarter_num == 2 ~ paste0(
"Jan-Mar ",
lubridate::year(date)
),
quarter_num == 3 ~ paste0(
"Apr-Jun ",
lubridate::year(date)
),
quarter_num == 4 ~ paste0(
"Jul-Sep ",
lubridate::year(date)
)
))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.