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