#' Returns the number of days the month of a given date
#'
#' @param date a Date or POSIXct
#' @return numeric number of days in month of date
#' @keywords internal
ndays <- function(date) {
if (length(date) != 1) {
stop(length(date), " arguments passed to 'ndays' which requires 1")
}
last_days <- 28:31
rev(last_days[which(!is.na(as.Date(paste(substr(date, 1, 8),
last_days, sep = ''), '%Y-%m-%d')))])[1]
}
#' Returns the period padded to full days
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
day_period <- function(period) UseMethod("day_period", object = period)
#' Returns the period padded to the weekly boundaries
#'
#' Currently only supports weeks starting sunday, need to eventually support
#' start.on.monday passthrough.
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
week_period <- function(period) UseMethod("week_period", object = period)
#' Returns the period padded to the month boundaries
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
month_period <- function(period) UseMethod("month_period", object = period)
#' Returns the period padded to the quarter boundaries
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
quarter_period <- function(period) UseMethod("quarter_period", object = period)
#' Returns the period padded to the year boundaries
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
year_period <- function(period) UseMethod("year_period", object = period)
#' Returns the period padded to the water year boundaries
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
wateryear_period <- function(period) UseMethod("wateryear_period", object = period)
#' Returns the period padded to the decade boundaries
#'
#' @param period Date or POSIXct vector representing period of time
#' @return new period representing the padded range
#' @keywords internal
decade_period <- function(period) UseMethod("decade_period", object = period)
day_period.Date <- function(period) {
return(c(as.Date(format(period[1], '%Y-%m-%d')),
as.Date(format(period[2], '%Y-%m-%d'))))
}
day_period.POSIXt <- function(period) {
return(posix_boundaries(day_period.Date(period)))
}
week_period.Date <- function(period) {
return(c(as.Date(period[1]) - as.integer(format(as.Date(period[1]), '%w')), # 0 = sunday
as.Date(period[2]) + (6 - as.integer(format(as.Date(period[2]), '%w'))))) # 6 = saturday
}
week_period.POSIXt <- function(period) {
return(posix_boundaries(week_period.Date(period)))
}
month_period.Date <- function(period) {
return(c(as.Date(format(period[1], '%Y-%m-01')),
as.Date(format(period[2], paste0('%Y-%m-', ndays(period[2]))))))
}
month_period.POSIXt <- function(period) {
return(posix_boundaries(month_period.Date(period)))
}
quarter_period.Date <- function(period) {
qs <- quarters(period)
formats <- lapply(qs, switch,
"Q1"=c("%Y-01-01", "%Y-03-31"),
"Q2"=c("%Y-04-01", "%Y-06-30"),
"Q3"=c("%Y-07-01", "%Y-09-30"),
"Q4"=c("%Y-10-01", "%Y-12-31"))
return(c(as.Date(format(period[1], formats[[1]][1])), as.Date(format(period[2], formats[[2]][2]))))
}
quarter_period.POSIXt <- function(period) {
return(posix_boundaries(quarter_period.Date(period)))
}
year_period.Date <- function(period) {
return(c(as.Date(format(period[1], '%Y-01-01')),
as.Date(format(period[2], '%Y-12-31'))))
}
year_period.POSIXt <- function(period) {
return(posix_boundaries(year_period.Date(period)))
}
wateryear_period.Date <- function(period) {
year <- sapply(period, function(instant) {
offset <- ifelse(format(instant, "%m") < 10, 0, 1)
return(as.integer(format(instant, "%Y")) + offset)
})
return(c(as.Date(paste0(year[1]-1, "-10-01")), as.Date(paste0(year[2], "-09-30"))))
}
wateryear_period.POSIXt <- function(period) {
return(posix_boundaries(wateryear_period.Date(period)))
}
decade_period.Date <- function(period) {
years <- c(floor(as.integer(format(period[1], "%Y"))/10)*10,
(ceiling(as.integer(format(period[2], "%Y"))/10)*10)-1)
return(c(as.Date(paste0(years[1], "-01-01")), as.Date(paste0(years[2], "-12-31"))))
}
decade_period.POSIXt <- function(period) {
return(posix_boundaries(decade_period.Date(period)))
}
posix_boundaries <- function(period) {
return(c(as.POSIXct(format(period[1], '%Y-%m-%d 00:00:00')),
as.POSIXct(format(period[2], '%Y-%m-%d 23:59:59'))))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.