Nothing
#' @include periods.r
NULL
#' Get/set months component of a date-time
#'
#' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo,
#' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects.
#'
#' @param x a date-time object
#' @param label logical. TRUE will display the month as a character string such
#' as "January." FALSE will display the month as a number.
#' @param abbr logical. FALSE will display the month as a character string
#' label, such as "January". TRUE will display an abbreviated version of the
#' label, such as "Jan". abbr is disregarded if label = FALSE.
#' @param value a numeric object
#' @param locale for month, locale to use for month names. Default to current locale.
#' @return If `label = FALSE`: month as number (1-12, 1 = January, 12 = December),
#' otherwise as an ordered factor.
#' @keywords utilities manip chron methods
#' @examples
#' x <- ymd("2012-03-26")
#' month(x)
#' month(x) <- 1
#' month(x) <- 13
#' month(x) > 3
#'
#' month(ymd(080101))
#' month(ymd(080101), label = TRUE)
#' month(ymd(080101), label = TRUE, abbr = FALSE)
#' month(ymd(080101) + months(0:11), label = TRUE)
#' @export
month <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
UseMethod("month")
}
#' @export
month.default <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
month(as.POSIXlt(x, tz = tz(x))$mon + 1, label, abbr, locale = locale)
}
#' @export
month.numeric <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
if (!all(x[!is.na(x)] %in% 1:12)) {
stop("Values are not in 1:12")
}
if (!label) {
return(x)
}
names <- .get_locale_regs(locale)$month_names
labels <- if (abbr) names$abr else names$full
ordered(x, levels = 1:12, labels = labels)
}
#' @export
month.Period <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) {
slot(x, "month")
}
as_month <- function(value) {
## FIXME: use same technique as in as_week_start to localize this
if (is.character(value)) {
value <- pmatch(
tolower(value),
c(
"january", "february", "march",
"june", "july", "august", "september",
"october", "november", "december"
)
)
}
value
}
#' @rdname month
#' @export
setGeneric("month<-",
function (x, value) standardGeneric("month<-"),
useAsDefault = function(x, value) {
y <- update_datetime(as.POSIXct(x), months = value, roll_month = "NAym")
reclass_date(y, x)
}
)
#' @export
setMethod("month<-", "Duration", function(x, value) {
x <- x + months(as_month(value) - month(x))
})
#' @export
setMethod("month<-", signature("Period"), function(x, value) {
slot(x, "month") <- as_month(value)
x
})
#' @export
setMethod("month<-", "Interval", function(x, value) {
x <- x + months(as_month(value) - month(x))
})
#' @export
setMethod("month<-", "POSIXt", function(x, value) {
update_datetime(x, months = value, roll_month = "NAym")
})
#' @export
setMethod("month<-", "Date", function(x, value) {
update_datetime(x, months = value, roll_month = "NAym")
})
#' Get the number of days in the month of a date-time
#'
#' Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr,
#' zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects.
#'
#' @export
#' @param x a date-time object
#' @return An integer of the number of days in the month component of the date-time object.
days_in_month <- function(x) {
month_x <- month(x, label = TRUE, locale = "C")
n_days <- N_DAYS_IN_MONTHS[month_x]
n_days[month_x == "Feb" & leap_year(x)] <- 29L
n_days
}
## fixme: integrate with above, this oen is needed internally
.days_in_month <- function(m, y) {
n_days <- N_DAYS_IN_MONTHS[m]
n_days[m == 2L & leap_year(y)] <- 29L
n_days
}
## tothink: export?
days_in_months_so_far <- function(month, leap) {
## if month is negative, compute from the end of the year
cum_days_pos <- c(0, cumsum(N_DAYS_IN_MONTHS)[-12])
cum_days_neg <- c(0, cumsum(rev(N_DAYS_IN_MONTHS))[-12])
negative <- month < 0
positive <- month > 0
sofar <- integer(length(month))
sofar[negative] <- cum_days_neg[-month[negative]]
sofar[positive] <- cum_days_pos[month[positive]]
adjust <- leap & ((negative & month == -12) | (positive & month > 2))
sofar[adjust] <- sofar[adjust] + 1L
sofar
}
## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(T, 6))
## [1] 0 31 60 275 306 335
## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(F, 6))
## [1] 0 31 59 275 306 334
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.