R/season.R

In camroach87/myhelpr: Helper Functions

#' Get season
#'
#' Returns the season of the year for a date-time object.
#'
#' @param x A date-time object.
#' @param label Logical. If TRUE, will display the season as a string (e.g.
#'   "Summer"). If False, the season will be returned as a numeric value.
#' @param shoulder Logical. If TRUE only Summer and Winter are returned with the
#'   shoulder months included in each. So summer will include October, November,
#'   December, January, February, March and Winter will include April, May,
#'   June, July, August, September. Note that if this is set to true only a
#'   label version of the season will be returned.
#' @return The seasons of the year as a numeric value (1-4) or as an ordered
#'   factor ("Summer", "Autumn", "Winter", "Spring").
#' @export
#'
#' @examples
#' require(lubridate)
#' x <- dmy("12/1/2010")
#' season(x, label = FALSE)
#' # 1
#'
#' x <- dmy_hm(c("1/5/2015 12:00", "1/7/2015 15:00", "1/11/2016 2:00"))
#' season(x)
#' # Autumn Winter Spring
#' # Levels: Summer < Autumn < Winter < Spring
season <- function(x, label = TRUE, shoulder = FALSE) {
  UseMethod("season")
}

#' @export
season.default <- function(x, label = TRUE, shoulder = FALSE) {
  x <- lubridate::month(x)
  if (shoulder == FALSE) {
    if (label == TRUE) {
      season_month_lkp$Season_label[x]
    } else if (label == FALSE) {
      season_month_lkp$Season[x]
    }
  } else if (shoulder == TRUE) {
    season_month_lkp$Season_shoulder[x]
  }
}