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