R/dates.R

In aelhabr/teutils: Tony's Personal Package

#' 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)
}