1#' @include periods.r 2NULL 3 4#' Get/set months component of a date-time 5#' 6#' Date-time must be a POSIXct, POSIXlt, Date, Period, chron, yearmon, yearqtr, zoo, 7#' zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. 8#' 9#' @param x a date-time object 10#' @param label logical. TRUE will display the month as a character string such 11#' as "January." FALSE will display the month as a number. 12#' @param abbr logical. FALSE will display the month as a character string 13#' label, such as "January". TRUE will display an abbreviated version of the 14#' label, such as "Jan". abbr is disregarded if label = FALSE. 15#' @param value a numeric object 16#' @param locale for month, locale to use for month names. Default to current locale. 17#' @return If `label = FALSE`: month as number (1-12, 1 = January, 12 = December), 18#' otherwise as an ordered factor. 19#' @keywords utilities manip chron methods 20#' @examples 21#' x <- ymd("2012-03-26") 22#' month(x) 23#' month(x) <- 1 24#' month(x) <- 13 25#' month(x) > 3 26#' 27#' month(ymd(080101)) 28#' month(ymd(080101), label = TRUE) 29#' month(ymd(080101), label = TRUE, abbr = FALSE) 30#' month(ymd(080101) + months(0:11), label = TRUE) 31#' @export 32month <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) 33 UseMethod("month") 34 35#' @export 36month.default <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) 37 month(as.POSIXlt(x, tz = tz(x))$mon + 1, label, abbr, locale = locale) 38 39#' @export 40month.numeric <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) { 41 if (!all(x[!is.na(x)] %in% 1:12)) 42 stop("Values are not in 1:12") 43 44 if (!label) { 45 return(x) 46 } 47 48 names <- .get_locale_regs(locale)$month_names 49 labels <- if (abbr) names$abr else names$full 50 51 ordered(x, levels = 1:12, labels = labels) 52} 53 54#' @export 55month.Period <- function(x, label = FALSE, abbr = TRUE, locale = Sys.getlocale("LC_TIME")) 56 slot(x, "month") 57 58#' @rdname month 59#' @export 60"month<-" <- function(x, value) { 61 ## FIXME: how to make this localized and preserve backward compatibility? Guesser? 62 if (!is.numeric(value)) { 63 value <- pmatch(tolower(value), 64 c("january", "february", "march", 65 "june", "july", "august", "september", 66 "october", "november", "december")) 67 } 68 x <- x + months(value - month(x)) 69 } 70 71setGeneric("month<-") 72 73#' @export 74setMethod("month<-", signature("Period"), function(x, value) { 75 slot(x, "month") <- value 76 x 77}) 78 79#' Get the number of days in the month of a date-time 80#' 81#' Date-time must be a POSIXct, POSIXlt, Date, chron, yearmon, yearqtr, 82#' zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, and fts objects. 83#' 84#' @export 85#' @param x a date-time object 86#' @return An integer of the number of days in the month component of the date-time object. 87days_in_month <- function(x) { 88 month_x <- month(x, label = TRUE, locale = "C") 89 n_days <- N_DAYS_IN_MONTHS[month_x] 90 n_days[month_x == "Feb" & leap_year(x)] <- 29L 91 n_days 92} 93 94## fixme: integrate with above, this oen is needed internally 95.days_in_month <- function(m, y) { 96 n_days <- N_DAYS_IN_MONTHS[m] 97 n_days[m == 2L & leap_year(y)] <- 29L 98 n_days 99} 100 101## tothink: export? 102days_in_months_so_far <- function(month, leap) { 103 ## if month is negative, compute from the end of the year 104 cum_days_pos <- c(0, cumsum(N_DAYS_IN_MONTHS)[-12]) 105 cum_days_neg <- c(0, cumsum(rev(N_DAYS_IN_MONTHS))[-12]) 106 negative <- month < 0 107 positive <- month > 0 108 sofar <- integer(length(month)) 109 sofar[negative] <- cum_days_neg[-month[negative]] 110 sofar[positive] <- cum_days_pos[month[positive]] 111 adjust <- leap & ((negative & month == -12) | (positive & month > 2)) 112 sofar[adjust] <- sofar[adjust] + 1L 113 sofar 114} 115## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(T, 6)) 116## [1] 0 31 60 275 306 335 117## days_in_months_so_far(c(1, 2, 3, -10, -11, -12), rep.int(F, 6)) 118## [1] 0 31 59 275 306 334 119