#' Create a date
#'
#' @description Create a date object (or, alternatively, a character) given date parameters.
#' @details This function was originally used for some work-related project(s) (for outages).
#' @param yyyy numeric. Year.
#' @param mm numeric. Month.
#' @param dd numeric. Day.
#' @param default_day logical. Indicates whether to set a default day. Used ONLY if \code{dd} is missing.
#' @param as_date logical. Indiciates whether to convert the return value to a date.
#' @param sep character. Used ONLY in the case that \code{as_date = FALSE}.
#' @export
#' @importFrom lubridate ymd
get_yyyymmdd <-
function(yyyy = NULL,
mm = NULL,
dd,
default_day = TRUE,
as_date = TRUE,
sep = "-") {
stopifnot(!is.null(yyyy) && !is.null(mm))
if (missing(dd)) {
if (default_day) {
dd_default <- 1
dd <- dd_default
message(
"Setting `dd = ",
dd_default,
"` because none is provided (and `default_day == `TRUE`."
)
} else {
# dd <- NULL
warning("Returning nothing because `dd` is missing and `default_day == FALSE`.")
return(invisible())
}
}
# date <-
# paste(sprintf("%04d", yyyy),
# sprintf("%02d", mm),
# sprintf("%02d", dd),
# sep = sep)
date <- sprintf("%04.0f%s%02.0f%s%02.0f", yyyy, sep, mm, sep, dd)
date <- lubridate::ymd(date)
# Although the conversion to a date could be done here (instead of re-converting back to a character)
# this is done because returning a character is the second option.
if (!as_date)
date <- as.character(date)
date
}
#'
#' Create a date (for a plot)
#'
#' @description Create a month-year label. Intended to be used for \code{ggplot2} plots primarily
#' (but perhaps also \code{kable} tables).
#' @details This function was originally used for some work-related project(s) (for outages).
#' @inheritParams get_yyyymmdd
#' @param upper logical. Indicates whether to upper-case ALL letters in month name.
#' @param format character. Format expression.
#' @export
get_yyyymm <-
function(yyyy = NULL,
mm = NULL,
format = "%b %Y",
# format = "",
upper = FALSE) {
stopifnot(!is.null(yyyy) && !is.null(mm))
# date <-
# paste(sprintf("%04d", yyyy), sprintf("%02d", mm), "01", sep = "-")
dd <- 1
sep <- "-"
date <- sprintf("%04.0f%s%02.0f%s%02.0f", yyyy, sep, mm, sep, dd)
# format <- "%b %Y"
yyyymm <- strftime(date, format = format)
if (upper)
yyyymm <- toupper(yyyymm)
yyyymm
}
#' Identify the last day in a month
#'
#' @description None.
#' @details This function was originally used for some work-related project(s) (for outages).
#' @inheritParams get_yyyymmdd
#' @export
#' @importFrom lubridate ymd days_in_month
get_month_lastday <-
function(yyyy = NULL,
mm = NULL,
dd) {
stopifnot(!is.null(yyyy) && !is.null(mm))
if (missing(dd)) {
dd_default <- 1
dd <- dd_default
message("Setting `dd = ",
dd_default,
"` because none is provided.")
}
# date <-
# paste(sprintf("%04d", yyyy),
# sprintf("%02d", mm),
# sprintf("%02d", dd),
# sep = "-")
sep <- "-"
date <- sprintf("%04.0f%s%02.0f%s%02.0f", yyyy, sep, mm, sep, dd)
date <- lubridate::ymd(date)
as.numeric(lubridate::days_in_month(date))
}
#' Add timestamp columns
#'
#' @description Creates new columns for time to a data.frame.
#' @details Useful for iterating over temporal data stored in separate files.
#' @param data data.frame
#' @inheritParams get_yyyymmdd
#' @export
#' @importFrom dplyr mutate select everything
add_yyyymmdd_cols <- function(data, yyyy, mm, dd) {
out <- dplyr::mutate(data, yyyy = yyyy, mm = mm, dd = dd)
out <- dplyr::select(out, yyyy, mm, dd, dplyr::everything())
}
#' @export
#' @rdname add_yyyymmdd_cols
add_yyyymm_cols <- function(data, yyyy, mm) {
out <- dplyr::mutate(data, yyyy = yyyy, mm = mm)
out <- dplyr::select(out, yyyy, mm, dplyr::everything())
}
#' Extract date columns.
#'
#' @description Identifies the columns in a data.frame with names formatted as dates.
#' @details Should be used for "wide" data.frames.
#' @inheritParams add_yyyymmdd_cols
#' @export
get_dates_colnames <- function(data) {
out <- grep("[0-9]{4}-[0-9]{2}-[0-9]{2}", names(data), value = TRUE)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.