查找特定date属于哪个季节

我有一个date的vector,每个项目,我想分配一个赛季。 例如,如果date在21.12之间。 和21.3。,我会说那是winter 。 到目前为止,我已经尝试了下面的代码,但无论年份如何,我都不能使它更通用。

 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" 

我已经尝试格式化没有一年的date,但它不工作。

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

如何使用这样的东西:

 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" 

一个说明: 2012年是转换所有date的好年份; 因为这是一个闰年,所以在你的数据集中的任何2月29日都将顺利处理。

我有一些和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> 

这是一个testing:

 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> 

我会创build一个查找表,并从那里去。 一个例子(注意使用d()函数的代码混淆以及填充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 

创build查找表后,您可以很容易地从它提取到一个月/天组合所属的季节:

 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 

所有很好,vector化:)。 我觉得桌子一旦创build就会很快

我认为这样做,但这是一个丑陋的解决scheme:

  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" 

我的解决scheme并不快,但对于季节的开始是灵活的,只要它们在函数assignSeason首先在数据assignSeason 。 它需要magrittr的pipe道function, year函数lubridate和dplyr 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) } 

示例数据:

 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 

结果:

  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 

我认为图书馆动物园会很容易

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