Skip to content

Instantly share code, notes, and snippets.

@artemklevtsov
Last active March 16, 2020 17:46
Show Gist options
  • Save artemklevtsov/6b39f44fa2745cf970770cc0b9445693 to your computer and use it in GitHub Desktop.
Save artemklevtsov/6b39f44fa2745cf970770cc0b9445693 to your computer and use it in GitHub Desktop.
Floor dates function
#' @title Floor Dates
#' @param x A vector of date.
#' @param unit A character string specifying a time unit.
#' @param start.on.monday Should the week start on Mondays or Sundays?
#' @return An object of class "Date".
floor_date <- function(x, unit = c("day", "week", "month", "quarter", "year"), start.on.monday = TRUE) {
stopifnot(is(x, "Date"))
unit <- match.arg(unit)
if (unit == "day") {
return(x)
}
if (unit == "week") {
l <- ((unclass(ll) - 3L) %/% 7L) * 7L + 4L
if (start.on.monday) {
return(.Date(7 * ((unclass(x) - 4L) %/% 7) + 4L))
} else {
return(.Date(7 * ((unclass(x) - 3L) %/% 7) + 3L))
}
} else {
l <- as.POSIXlt(x)
l <- switch(
unit,
month = l$mday,
quarter = l$mon %/% 3L,
year = l$year
)
}
return(x - l + 1L)
}
@artemklevtsov
Copy link
Author

artemklevtsov commented Mar 16, 2020

Anyway, we might consider supporting that in trunc.IDate if you could please file PR pray

Good idea. I'll do it.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment