1#' @include accessors-month.r
2NULL
3
4#' Get the fiscal quarter and semester of a date-time
5#'
6#' Quarters divide the year into fourths. Semesters divide the year into halfs.
7#'
8#' @param x a date-time object of class POSIXct, POSIXlt, Date, chron, yearmon,
9#'   yearqtr, zoo, zooreg, timeDate, xts, its, ti, jul, timeSeries, fts or
10#'   anything else that can be converted with as.POSIXlt
11#' @param type the format to be returned for the quarter. Can be one one of
12#'   "quarter" - return numeric quarter (default), "year.quarter" return
13#'   fractional numeric year.quarter, "date_first" or "date_last" which return
14#'   the date at the quarter's start end end.
15#' @param fiscal_start numeric indicating the starting month of a fiscal year.
16#' @param with_year logical indicating whether or not to include the quarter or
17#'   semester's year (deprecated; use the `type` parameter instead).
18#' @return numeric or a vector of class POSIXct if `type` argument is
19#'   `date_first` or `date_last`
20#' @examples
21#' x <- ymd(c("2012-03-26", "2012-05-04", "2012-09-23", "2012-12-31"))
22#' quarter(x)
23#' quarter(x, type = "year.quarter")
24#' quarter(x, type = "year.quarter", fiscal_start = 11)
25#' quarter(x, type = "date_first", fiscal_start = 11)
26#' quarter(x, type = "date_last", fiscal_start = 11)
27#' semester(x)
28#' semester(x, with_year = TRUE)
29#' @export
30quarter <- function(x, type = "quarter", fiscal_start = 1, with_year = identical(type, "year.quarter")) {
31  if (length(fiscal_start) > 1)
32    stop("`fiscal_start` must be a singleton", call. = FALSE)
33  fs <- (fiscal_start - 1) %% 12
34  shifted <- seq(fs, 11 + fs) %% 12 + 1
35  m <- month(x)
36  quarters <- rep(1:4, each = 3)
37  s <- match(m, shifted)
38  q <- quarters[s]
39
40  ## Doing this to handle positional calls where previously `with_year` was the
41  ## second param, and also now to handle soft-deprecation of `with_year`.
42  if (is.logical(type))
43    type <- if (type) "year.quarter" else "quarter"
44  if (with_year == TRUE)
45    type <- "year.quarter"
46
47  switch(type,
48    "quarter" = q,
49    "year.quarter" = {
50      nxt_year_months <- if (fs != 0) (fs + 1):12
51      year(x) + (m %in% nxt_year_months) + (q / 10)
52    },
53    "date_first" = ,
54    "date_last" = {
55      starting_months <- shifted[seq(1, length(shifted), 3)]
56      final_years <- year(x) - (starting_months[q] > m)
57      quarter_starting_dates <-
58        make_date(year = final_years, month = starting_months[q], day = 1L)
59      if (type == 'date_first') {
60        quarter_starting_dates
61      } else if (type == 'date_last') {
62        add_with_rollback(quarter_starting_dates, months(3)) - days(1)
63      }
64    },
65    stop("Unsuported type ", type)
66  )
67}
68
69#' @rdname quarter
70#' @export
71semester <- function(x, with_year = FALSE) {
72  m <- month(x)
73  semesters <- rep(1:2, each = 6)
74  s <- semesters[m]
75  if (with_year) year(x) + s/10
76  else  s
77}
78