Find which season a particular date belongs to
RDateR Problem Overview
I have a vector of dates and for each entry, I would like to assign a season. So for example, if a date is between 21.12. and 21.3., I would says that's winter. So far I have tried the following code but I couldn't make it more generic, irrespective of the year.
my.dates <- as.Date("2011-12-01", format = "%Y-%m-%d") + 0:60
low.date <- as.Date("2011-12-15", format = "%Y-%m-%d")
high.date <- as.Date("2012-01-15", format = "%Y-%m-%d")
my.dates[my.dates <= high.date & my.dates >= low.date]
[1] "2011-12-15" "2011-12-16" "2011-12-17" "2011-12-18" "2011-12-19" "2011-12-20" "2011-12-21" "2011-12-22" "2011-12-23" "2011-12-24" "2011-12-25"
[12] "2011-12-26" "2011-12-27" "2011-12-28" "2011-12-29" "2011-12-30" "2011-12-31" "2012-01-01" "2012-01-02" "2012-01-03" "2012-01-04" "2012-01-05"
[23] "2012-01-06" "2012-01-07" "2012-01-08" "2012-01-09" "2012-01-10" "2012-01-11" "2012-01-12" "2012-01-13" "2012-01-14" "2012-01-15"
I have tried formatting the dates without the year, but it isn't working.
ld <- as.Date("12-15", format = "%m-%d")
hd <- as.Date("01-15", format = "%m-%d")
my.dates[my.dates <= hd & my.dates >= ld]
R Solutions
Solution 1 - R
How about using something like this:
getSeason <- function(DATES) {
WS <- as.Date("2012-12-15", format = "%Y-%m-%d") # Winter Solstice
SE <- as.Date("2012-3-15", format = "%Y-%m-%d") # Spring Equinox
SS <- as.Date("2012-6-15", format = "%Y-%m-%d") # Summer Solstice
FE <- as.Date("2012-9-15", format = "%Y-%m-%d") # Fall Equinox
# Convert dates from any year to 2012 dates
d <- as.Date(strftime(DATES, format="2012-%m-%d"))
ifelse (d >= WS | d < SE, "Winter",
ifelse (d >= SE & d < SS, "Spring",
ifelse (d >= SS & d < FE, "Summer", "Fall")))
}
my.dates <- as.Date("2011-12-01", format = "%Y-%m-%d") + 0:60
head(getSeason(my.dates), 24)
# [1] "Fall" "Fall" "Fall" "Fall" "Fall" "Fall" "Fall"
# [8] "Fall" "Fall" "Fall" "Fall" "Fall" "Fall" "Fall"
# [15] "Winter" "Winter" "Winter" "Winter" "Winter" "Winter"
One note: 2012 is a good year to which to convert all of the dates; since it is a leap year, any February 29ths in your data set will be handled smoothly.
Solution 2 - R
I have something similarly ugly as Tim:
R> toSeason <- function(dat) {
+
+ stopifnot(class(dat) == "Date")
+
+ scalarCheck <- function(dat) {
+ m <- as.POSIXlt(dat)$mon + 1 # correct for 0:11 range
+ d <- as.POSIXlt(dat)$mday # correct for 0:11 range
+ if ((m == 3 & d >= 21) | (m == 4) | (m == 5) | (m == 6 & d < 21)) {
+ r <- 1
+ } else if ((m == 6 & d >= 21) | (m == 7) | (m == 8) | (m == 9 & d < 21)) {
+ r <- 2
+ } else if ((m == 9 & d >= 21) | (m == 10) | (m == 11) | (m == 12 & d < 21)) {
+ r <- 3
+ } else {
+ r <- 4
+ }
+ r
+ }
+
+ res <- sapply(dat, scalarCheck)
+ res <- ordered(res, labels=c("Spring", "Summer", "Fall", "Winter"))
+ invisible(res)
+ }
R>
And here is a test:
R> date <- Sys.Date() + (0:11)*30
R> DF <- data.frame(Date=date, Season=toSeason(date))
R> DF
Date Season
1 2012-02-29 Winter
2 2012-03-30 Spring
3 2012-04-29 Spring
4 2012-05-29 Spring
5 2012-06-28 Summer
6 2012-07-28 Summer
7 2012-08-27 Summer
8 2012-09-26 Fall
9 2012-10-26 Fall
10 2012-11-25 Fall
11 2012-12-25 Winter
12 2013-01-24 Winter
R> summary(DF)
Date Season
Min. :2012-02-29 Spring:3
1st Qu.:2012-05-21 Summer:3
Median :2012-08-12 Fall :3
Mean :2012-08-12 Winter:3
3rd Qu.:2012-11-02
Max. :2013-01-24
R>
Solution 3 - R
I would create a lookup table, and go from there. An example (note the code obfuscation using the d() function and the pragmatic way of filling the lut):
# Making lookup table (lut), only needed once. You can save
# it using save() for later use. Note I take a leap year.
d = function(month_day) which(lut$month_day == month_day)
lut = data.frame(all_dates = as.POSIXct("2012-1-1") + ((0:365) * 3600 * 24),
season = NA)
lut = within(lut, { month_day = strftime(all_dates, "%b-%d") })
lut[c(d("Jan-01"):d("Mar-20"), d("Dec-21"):d("Dec-31")), "season"] = "winter"
lut[c(d("Mar-21"):d("Jun-20")), "season"] = "spring"
lut[c(d("Jun-21"):d("Sep-20")), "season"] = "summer"
lut[c(d("Sep-21"):d("Dec-20")), "season"] = "autumn"
rownames(lut) = lut$month_day
After creating the lookup table, you can extract quite easily from it to what season a month/day combination belongs to:
dat = data.frame(dates = Sys.Date() + (0:11)*30)
dat = within(dat, {
season = lut[strftime(dates, "%b-%d"), "season"]
})
> dat
dates season
1 2012-02-29 winter
2 2012-03-30 spring
3 2012-04-29 spring
4 2012-05-29 spring
5 2012-06-28 summer
6 2012-07-28 summer
7 2012-08-27 summer
8 2012-09-26 autumn
9 2012-10-26 autumn
10 2012-11-25 autumn
11 2012-12-25 winter
12 2013-01-24 winter
All nice and vectorized :). I think once the table is created, this is very quick.
Solution 4 - R
Simply use time2season function. It gets date and generates season:
time2season(x, out.fmt = "months", type="default")
You can find more infromation here.
Solution 5 - R
I think this would do it, but it's an ugly solution:
my.dates <- as.Date("2011-12-01", format = "%Y-%m-%d") + 0:60
ld <- as.Date("12-15", format = "%m-%d")
hd <- as.Date("01-15", format = "%m-%d")
my.dates2 <- as.Date(unlist(lapply(strsplit(as.character(my.dates),split=""),function(x) paste(x[6:10],collapse=""))),format="%m-%d")
my.dates[my.dates2 <= hd | my.dates2 >= ld]
[1] "2011-12-15" "2011-12-16" "2011-12-17" "2011-12-18" "2011-12-19"
[6] "2011-12-20" "2011-12-21" "2011-12-22" "2011-12-23" "2011-12-24"
[11] "2011-12-25" "2011-12-26" "2011-12-27" "2011-12-28" "2011-12-29"
[16] "2011-12-30" "2011-12-31" "2012-01-01" "2012-01-02" "2012-01-03"
[21] "2012-01-04" "2012-01-05" "2012-01-06" "2012-01-07" "2012-01-08"
[26] "2012-01-09" "2012-01-10" "2012-01-11" "2012-01-12" "2012-01-13"
[31] "2012-01-14" "2012-01-15"
Solution 6 - R
My solution is not fast but is flexible about the starts of the seasons as long as they are defined in a dataframe first for the function assignSeason. It requires magrittr for the piping functions, lubridate for the year function, and dplyr for mutate.
seasons <- data.frame(
SE = as.POSIXct(c("2009-3-20", "2010-3-20", "2011-3-20", "2012-3-20",
"2013-3-20", "2014-3-20"), format="%Y-%m-%d"),
SS = as.POSIXct(c("2009-6-21", "2010-6-21", "2011-6-21", "2012-6-20",
"2013-6-21", "2014-6-21"), format="%Y-%m-%d"),
FE = as.POSIXct(c("2009-9-22", "2010-9-23", "2011-9-23", "2012-9-22",
"2013-9-22", "2014-9-23"), format="%Y-%m-%d"),
WS = as.POSIXct(c("2009-12-21", "2010-12-21", "2011-12-22", "2012-12-21",
"2013-12-21", "2014-12-21"), format="%Y-%m-%d")
)
assignSeason <- function(dat, SeasonStarts=seasons) {
dat %<>% mutate(
Season = lapply(Date,
function(x) {
findInterval(
x,
SeasonStarts[which(year(x)==year(SeasonStarts$WS)), ]
)
}
) %>% unlist
)
dat[which(dat$Season==0 | dat$Season==4), ]$Season <- "Winter"
dat[which(dat$Season==1), ]$Season <- "Spring"
dat[which(dat$Season==2), ]$Season <- "Summer"
dat[which(dat$Season==3), ]$Season <- "Fall"
return(dat)
}
Example data:
dat = data.frame(
Date = as.POSIXct(strptime(as.Date("2011-12-01", format = "%Y-%m-%d") +
(0:10)*30, format="%Y-%m-%d"))
)
dat %>% assignSeason
Result:
Date Season
1 2011-12-01 Fall
2 2011-12-31 Winter
3 2012-01-30 Winter
4 2012-02-29 Winter
5 2012-03-30 Spring
6 2012-04-29 Spring
7 2012-05-29 Spring
8 2012-06-28 Summer
9 2012-07-28 Summer
10 2012-08-27 Summer
11 2012-09-26 Fall
Solution 7 - R
Here a more general solution, that nevertheless needs 3 libraries... It considers all years and the hemisphere:
library(data.table)
library(zoo)
library(dplyr)
get.seasons <- function(dates, hemisphere = "N"){
years <- unique(year(dates))
years <- c(min(years - 1), max(years + 1), years) %>% sort
if(hemisphere == "N"){
seasons <- c("winter", "spring", "summer", "fall")}else{
seasons <- c("summer", "fall", "winter", "spring")}
dt.dates <- bind_rows(
data.table(date = as.Date(paste0(years, "-12-21")), init = seasons[1], type = "B"),# Summer in south hemisphere
data.table(date = as.Date(paste0(years, "-3-21")), init = seasons[2], type = "B"), # Fall in south hemisphere
data.table(date = as.Date(paste0(years, "-6-21")), init = seasons[3], type = "B"), # Winter in south hemisphere
data.table(date = as.Date(paste0(years, "-9-23")), init = seasons[4], type = "B"), # Winter in south hemisphere
data.table(date = dates, i = 1:(length(dates)), type = "A") # dates to compute
)[order(date)]
dt.dates[, init := zoo::na.locf(init)]
return(dt.dates[type == "A"][order(i)]$init)
}
Solution 8 - R
I think library zoo would be easy
library(zoo)
yq <- as.yearqtr(as.yearmon(DF$dates, "%m/%d/%Y") + 1/12)
DF$Season <- factor(format(yq, "%q"), levels = 1:4,
labels = c("winter", "spring", "summer", "fall"))
Solution 9 - R
8 years later and there is a really easy Lubridate answer for checking if X date is in Y date range.
as.Date("2020-05-01") %within% (as.Date("2020-01-01") %--% as.Date("2021-01-01"))
So you'd define your date ranges using the lubridate date range opperator, %--%
range_1 <- A_Date %--% Z_date
then to check if X date is within range_1 use %within%
library(lubridate)
summer <-
ymd(paste0(seq(2019, 2021), "-01", "-01")) %--% ymd(paste0(seq(2019, 2021), "-05", "-05"))
ymd("2020-02-01") %within% summer
since the above ranges are from 20xx-01-1 %--% 20xx-05-05 the query above returns FALSE, TRUE, FALSE but you could set a query to return TRUE if any are TRUE.
Solution 10 - R
The most accurate approach to this issue is by splitting up the season that intersects newyear.
Now I'm a c# guy but the idea behind the season check is the same for all languages. I've created a jsfiddle here: https://jsfiddle.net/pieterjandc/L3prwqmh/1/
Here is the core code, which splits up the season crossing the newyear, and performs the comparision:
const seasons = [{
name: 'Spring',
start: new Date(2000, 2, 21),
end: new Date(2000, 5, 20)
},{
name: 'Summer',
start: new Date(2000, 5, 21),
end: new Date(2000, 8, 20)
},{
name: 'Autumn/Fall',
start: new Date(2000, 8, 21),
end: new Date(2000, 11, 20)
},{
name: 'Winter',
start: new Date(2000, 11, 21),
end: new Date(2001, 2, 20)
}];
/** Checks if a date is within a specified season */
function checkSeason(season, date) {
let remappedStart = new Date(2000, season.start.getMonth(), season.start.getDate());
let remappedDate = new Date(2000, date.getMonth(), date.getDate());
let remappedEnd = new Date(2000, season.end.getMonth(), season.end.getDate());
// Check if the season crosses newyear
if (season.start.getFullYear() === season.end.getFullYear()) {
// Simple comparison
return (remappedStart <= remappedDate) && (remappedDate <= remappedEnd);
} else {
// Split the season, remap all to year 2000, and perform a simple comparison
return (remappedStart <= remappedDate) && (remappedDate <= new Date(2000, 11, 31))
|| (new Date(2000, 0, 1) <= remappedDate) && (remappedDate <= remappedEnd);
}
}
function findSeason(seasons, date) {
for (let i = 0; i < seasons.length; i++) {
let isInSeason = checkSeason(seasons[i], date);
if (isInSeason === true) {
return seasons[i];
}
}
return null;
}
Solution 11 - R
Bit late to the party but an additional base R solution (I stole @Josh O'Brien's brilliant logic for the astronomical seasons piece) updating the UTC dates for equinoxes and solstices for the 2016 - 2026 decade (i will endeavour to add a lookup table for the UTC dates for the equinoxes and solstices in the past and future).
# Function to take a date vector and return the season
# season_stamper => function
season_stamper <- function(
date_vec,
date_fmt = "%Y-%m-%d",
hemisphere = c("north", "south"),
season_type = c(
ifelse(hemisphere == "south",
"monthly periods", "astronomical"),
ifelse(hemisphere == "south",
"astronomical", "monthly periods")
)){
# Resolve which hemisphere was selected:
# hemisphere_selected => string scalar
hemisphere_selected <- match.arg(hemisphere)
# Extract the month number from the dates:
# mon_nos => integer vector
mon_nos <- (as.POSIXlt(strptime(date_vec, date_fmt))$mon + 1)
# Resolve the type of season: season_type_selected => character scalar
season_type_selected <- match.arg(season_type)
# If the season type is a 3-month period:
if(season_type_selected == "monthly periods"){
# Resolve the seasons based on the hemisphere:
# seasons => string vector
seasons <- switch(
hemisphere_selected,
"north"=c("Winter", "Spring", "Summer", "Fall"),
c("Summer", "Autumn", "Winter", "Spring")
)
# Stamp the date vector: season_stamps => string vector
season_stamps <- seasons[((mon_nos %/% (12 / 4)) %% 4 + 1)]
# Otherwise:
}else{
# Convert dates from any year to 2020: d=> Date Scalar
d <- as.Date(strftime(date_vec, format="2020-%m-%d"))
# If the dates are from the northern hemisphere:
if(hemisphere_selected == "north"){
# Store as a variable Date of the Winter Solstice for a leap year:
# WS => date scalar
WS <- as.Date("2020-12-21", format = "%Y-%m-%d")
# Store as a variable Date of the Spring Equinox for a leap year:
# SE => date scalar
SE <- as.Date("2020-3-20", format = "%Y-%m-%d")
# Store as a variable Date of the Summer Solstice for a leap year:
# SS => date scalar
SS <- as.Date("2020-6-21", format = "%Y-%m-%d")
# Store as a variable Date of the Fall Equinox for a leap year:
# SS => date scalar
FE <- as.Date("2020-9-22", format = "%Y-%m-%d")
# Resolve the season: season_stamps => character vector
season_stamps <- ifelse(d >= WS | d < SE, "Winter",
ifelse(d >= SE & d < SS, "Spring",
ifelse(d >= SS & d < FE, "Summer", "Fall")))
# Otherwise:
}else{
# Store as a variable Date of the Summer Solstice for a leap year:
# WS => date scalar
SS <- as.Date("2020-12-21", format = "%Y-%m-%d")
# Store as a variable the Date of the Autumn Equinox:
# AE => date scalar
AE <- as.Date("2020-3-20", format = "%Y-%m-%d")
# Store as a variable the Date of the Winter Solstice:
# WS => date scalar
WS <- as.Date("2020-6-21", format = "%Y-%m-%d")
# Store as a variable the DAte of the Spring Equinox:
# SE => date scalar
SE <- as.Date("2020-9-22", format = "%Y-%m-%d")
# Resolve the season: season_stamps => character vector
season_stamps <- ifelse(d >= SS | d < AE, "Summer",
ifelse(d >= SE & d < SS, "Spring",
ifelse(d >= WS & d < SE, "Winter", "Autumn")))
}
}
# Explicitly define the returned object:
# string vecctor => Global Env
return(season_stamps)
}
# Data:
my.dates <- as.Date("2019-12-01", format = "%Y-%m-%d") + 0:60
low.date <- as.Date("2019-12-15", format = "%Y-%m-%d")
high.date <- as.Date("2020-01-15", format = "%Y-%m-%d")
date_vec <- my.dates[my.dates <= high.date & my.dates >= low.date]