R/dates.R

In jedwards24/edwards: James Edwards personal package

#' Parse a character vector in a particular format and convert to a date or datetime
#'
#' Reads text vectors which are either in dmy or dmy:time format. If all of the times are
#' zeroes then the output is a date. Fully  `NA` vectors are returned as dates.
#'
#' @param x A character vector to be converted.
#'
#' @export
convert_date <- function(x) {
  if (!is.character(x)){
    stop("Input must be a character vector.")
  }
  if (all(is.na(x))) {
    message("Converted to a date (vector is all NA).")
    return(lubridate::as_date(x))
  }
  xstr <- x[which.max(stringr::str_length(x))]
  if (stringr::str_detect(xstr, ":")) {
    xsplit <- stringr::str_split_fixed(xstr, ":", 2)[, , drop = T]
    if (any(stringr::str_detect(xsplit[2], "[1-9]"))) {
      message("Converted to a datetime.")
      return(lubridate::dmy_hms(x))
    } else{
      x <- stringr::str_split_fixed(x, ":", 2)[, 1, drop = T]
    }
  }
  message("Converted to a date.")
  lubridate::dmy(x)
}

#' Test if a datetime object has times that are all zero
#'
#' Returns `TRUE` if the input is a datetime object where the time part of every element is zero.
#'
#' @param x An object to test.
#'
#' @examples
#'   x <- as.POSIXct("2009-08-03")
#'   y <- as.Date(x)
#'   is_simple_datetime(x) # TRUE
#'   is_simple_datetime(x + 1) # FALSE
#'   is_simple_datetime(y) # FALSE
#'
#' @export
is_simple_datetime <- function(x) {
  if (!lubridate::is.POSIXt(x)){
    return(FALSE)
  }
  x <- stats::na.omit(x)
  if(all(lubridate::hour(x) == 0) &
     all(lubridate::minute(x) == 0) &
     all(lubridate::second(x) == 0)){
    return(TRUE)
  }
  FALSE
}

#' Difference in days of two dates as a numeric
#'
#' Finds `difftime(date1, date2)` (i.e. `date1 - date2`) using `units = "days"`, then converts
#' to a numeric.
#'
#' By default, only the date part of any datetime inputs are used (the datetime is
#' first coerced to a date using `lubridate::as_date()`). If `keep_times = TRUE` and both
#' `date1` and `date2` are datetimes then the times will be used. See examples.
#'
#' @param date1,date2 A date or datetime.
#' @param keep_times Logical. If `FALSE` any times will be dropped before difference is calculated.
#' @examples
#' d1 <- lubridate::ymd_hms("2020-02-01 08:00:00")
#' d2 <- lubridate::ymd_hms("2020-01-01 00:00:00")
#' d3 <- lubridate::ymd("2020-01-01")
#' diff_days(d1, d2, keep_times = FALSE)
#' diff_days(d1, d2, keep_times = TRUE)
#' diff_days(d1, d3, keep_times = TRUE) # time in d1 not used since d3 is a date
#'
#' @export
diff_days <- function(date1, date2, keep_times = FALSE) {
  if (!lubridate::is.POSIXt(date1) & !lubridate::is.Date(date1)){
    stop("`date1` must be a date or datetime.", call. = FALSE)
  }
  if (!lubridate::is.POSIXt(date2) & !lubridate::is.Date(date2)){
    stop("`date2` must be a date or datetime.", call. = FALSE)
  }
  if (lubridate::is.POSIXt(date1) & lubridate::is.POSIXt(date2) & keep_times){
    return(as.numeric(difftime(date1, date2, units = "days")))
  }
  as.numeric(difftime(lubridate::as_date(date1), lubridate::as_date(date2), units = "days"))
}