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