public
Created

Returns the quarter in which the date appears.

  • Download Gist
getYearQuarter.R
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
#' Returns the year (fiscal or calendar) and quarter in which the date appears.
#'
#' This function will cut the given date vector into quarters (i.e. three month
#' increments) and return an ordered factor with levels defined to be the quarters
#' between the minimum and maximum dates in the given vector. The levels, by
#' default, will be formated as \code{FY2013-Q1}, however the \code{FY} and \code{Q}
#' can be changed using the \code{fy.prefix} and \code{quarter.prefix} parameters,
#' respectively.
#'
#' @param x vector of type \code{\link{Date}}.
#' @param firstMonth the month corresponding to the first month of the fiscal year.
#' Setting \code{firstMonth=1} is equivalent calenadar years.
#' @param fy.prefix the character string to paste before the year.
#' @param quarter.prefix the character string to paste before the quarter.
#' @param sep the separater between the year and quarter.
#' @param level.range the range to use for defining the levels in the returned
#' factor.
#' @export
#' @examples
#' dates <- as.Date(c('2013-04-03','2012-03-30','2011-10-31',
#' '2011-04-14','2010-04-22','2004-10-04',
#' '2000-02-29','1997-12-05','1997-04-23',
#' '1997-04-01'))
#' getYearQuarter(dates)
#' getYearQuarter(dates, firstMonth=1)
#' getYearQuarter(dates, 1, '', '', '')
#' \dontrun{
#' getYearQuarter(dates, level.range=as.Date(c('2010-01-01','2013-01-01')))
#' }
getYearQuarter <- function(x,
firstMonth=7,
fy.prefix='FY',
quarter.prefix='Q',
sep='-',
level.range=c(min(x), max(x)) ) {
if(level.range[1] > min(x) | level.range[2] < max(x)) {
warning(paste0('The range of x is greater than level.range. Values ',
'outside level.range will be returned as NA.'))
}
quarterString <- function(d) {
year <- as.integer(format(d, format='%Y'))
month <- as.integer(format(d, format='%m'))
y <- ifelse(firstMonth > 1 & month >= firstMonth, year+1, year)
q <- cut( (month - firstMonth) %% 12, breaks=c(-Inf,2,5,8,Inf),
labels=paste0(quarter.prefix, 1:4))
return(paste0(fy.prefix, y, sep, q))
}
vals <- quarterString(x)
levels <- unique(quarterString(seq(
as.Date(format(level.range[1], '%Y-%m-01')),
as.Date(format(level.range[2], '%Y-%m-28')), by='month')))
return(factor(vals, levels=levels, ordered=TRUE))
}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.