Trouver à quelle saison une date particulière appartient
J'ai un vecteur de dates et pour chaque entrée, j'aimerais assigner une saison. Ainsi, par exemple, si une date est comprise entre 21.12. et 21.3., je dirais que c'est winter. Jusqu'ici, j'ai essayé le code suivant, mais je ne pouvais pas le rendre plus générique, quelle que soit l'année .
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"
J'ai essayé de formater les dates sans l'année, mais cela ne fonctionne pas.
ld <- as.Date("12-15", format = "%m-%d")
hd <- as.Date("01-15", format = "%m-%d")
my.dates[my.dates <= hd & my.dates >= ld]
Pourquoi ne pas utiliser quelque chose comme ceci:
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"
Une note: 2012 est une bonne année pour convertir toutes les dates; S'agissant d'une année bissextile, les 29 février de votre ensemble de données seront traités sans problème.
J'ai quelque chose d'aussi moche que 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>
Et voici un 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>
Je créerais une table de consultation et partirais de là. Un exemple (notez le code obscurcissant en utilisant la fonction d() et la manière pragmatique de remplir le 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
Après avoir créé la table de consultation, vous pouvez extraire assez facilement de celle-ci à quelle combinaison saison/mois appartient:
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
Tout Nice et vectorisé :). Je pense qu'une fois la table créée, c'est très rapide.
Je pense que cela le ferait, mais c'est une solution laide:
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"
Je pense que la bibliothèque Zoo serait facile
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"))
Utilisez simplement la fonction time2season. Il obtient la date et génère la saison:
time2season(x, out.fmt = "months", type="default")
Vous pouvez trouver plus d'informations ici .
Voici une solution plus générale, qui nécessite néanmoins 3 bibliothèques ... Elle considère toutes les années et l'hémisphère:
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)
}
Ma solution n'est pas rapide, mais flexible en ce qui concerne le début des saisons, à condition qu'elles soient d'abord définies dans un cadre de données pour la fonction assignSeason. Il nécessite magrittr pour les fonctions de tuyauterie, lubrifier pour la fonction year et dplyr pour 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)
}
Exemple de données:
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
Résultat:
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