Znajdź, w którym sezonie konkretna data należy do

Question

Mam wektor dat i dla każdego wpisu, chciałbym przypisać sezon. Na przykład, jeśli data jest między 21.12. i 21.3., powiedziałbym, że to jest winter. Do tej pory próbowałem poniższy kod, ale nie mogłem uczynić go bardziej ogólny, niezależnie od roku.

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" 

Próbowałem formatować daty bez roku, ale to nie działa.

ld <- as.Date("12-15", format = "%m-%d") 
hd <- as.Date("01-15", format = "%m-%d") 
my.dates[my.dates <= hd & my.dates >= ld] 

Answer 1

Jak o użyciu coś takiego:

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" 

Jedna uwaga: 2012 jest dobry rok, do którego należy przeliczyć wszystkie daty; ponieważ jest to rok przestępny, wszelkie 29 lutego w twoim zestawie danych będzie obsługiwane płynnie.

Answer 2

myślę, że byłoby to zrobić, ale to brzydkie rozwiązanie:

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" 

Answer 3

mam coś podobnie brzydka jak 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> 

A oto 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> 

Answer 4

Chciałbym utworzyć tabelę przeglądową i przejść stamtąd. Przykładem (uwaga zaciemniania kodu za pomocą funkcji d() i pragmatyczny sposób napełniania 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 

Po utworzeniu tabeli odnośników można wyodrębnić dość łatwo z niego na co sezon należy kombinacja miesiąc/dzień na:

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 

Wszystkie ładne i wektoryzowane :). Myślę, że po utworzeniu stołu jest to bardzo szybkie.

Answer 5

Moje rozwiązanie nie jest szybkie, ale jest elastyczne w odniesieniu do początków pór roku, o ile są one zdefiniowane w ramce danych najpierw dla funkcji assignSeason. Wymaga magrittr dla funkcji rurociągów, lubridate dla funkcji year i dplyr dla 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) 
} 

Przykładowe dane:

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 

Wynik:

  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 

Answer 6

myślę biblioteka zoo byłby łatwy

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"))