r ggplot带季填补错误

Question

我无法在时间序列中正确地对组进行着色。看起来订单搞砸了。示例代码如下。任何提示？

library(ggplot2)

getSeason <- function(DATES) {
#found here https://stackoverflow.com/questions/9500114/find-which-season-a-particular-date-belongs-to
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")))
}

zz <- sample(1:10000,365)/1000
dag <- seq(as.Date("2014-01-01"), as.Date("2014-12-31"), by = "day")
seas <-  getSeason(dag)
test <- data.frame(zz,dag,seas)

ggplot(data=test, aes(x=dag,ymax=zz,ymin=0,fill=seas))+
geom_ribbon()

Answer 1

我运行此操作来测试您的数据，看起来您的winter位于数据的两端，导致2014-03-14 Winter在所有其他季节连接到2014-12-15 Winter。

ggplot(test, aes(dag)) + 
   geom_ribbon(aes(ymin = zz - 1, ymax = zz + 1), fill = "grey70") +
   geom_line(aes(y = zz, group = seas)) + facet_grid(. ~ seas)

你也可以在这里看到它，

ggplot(test, aes(x= dag, y= zz)) +
geom_line(aes(colour= seas)) +
geom_ribbon(aes(ymax= zz, ymin= zz, fill= seas), alpha = 0.2) 

可能的解决方案可能是像这样对数据进行子集化，

ggplot() + 
 geom_line(data=subset(test, dag < as.Date("2014-12-15") ), aes(dag,zz,colour=seas))  + 
 geom_line(data=subset(test, dag > as.Date("2014-12-15") ), aes(dag,zz,colour=seas)) 

Answer 2

您可以通过将数据分为两个，上下WS，并绘制两个geom_ribbon来解决此问题。因此，您将连续的WS系列转换为两个不连续的部分。

library(dplyr)
ggplot() +
  geom_ribbon(data = filter(test, dag >= "2014-12-15") ,
              aes(x = dag, ymax = zz, ymin = 0, fill = seas)) +
  geom_ribbon(data = filter(test, dag < "2014-12-15") ,
              aes(x = dag, ymax = zz, ymin = 0, fill = seas))

Answer 3

以下是需要lubridate包的一般解决方案。它也不需要难以阅读的ifelse()语法，而是使用cut()将日期向量拆分为与每个季节相对应的因子级别。

返回给定日期的季节字符向量的函数

getSeason <- function(DATES) {
  require(lubridate)

  # Get day of year of solstices
  solstices <- as.Date(c('3-15','6-15','9-15','12-15'),format = '%m-%d')
  solstice_day <- yday(solstices)

  # get year and day of year of dates
  dates_year <- year(DATES)
  dates_day <- yday(DATES)

  # Split dates vector into seasons
  season_label <- as.character(cut(dates_day, 
                                   breaks = c(0,solstice_day,367), 
                                   labels = c('winter','spring','summer','fall','winter_next')))

  # Deal with the second winter
  dates_year[season_label == 'winter_next'] <- dates_year[season_label == 'winter_next'] + 1
  season_label[season_label == 'winter_next'] <- 'winter'

  # Return seasons pasted with year
  paste0(season_label, dates_year)

}

绘制功能区的代码

library(ggplot2)
zz <- sample(1:10000,365)/1000
dag <- seq(as.Date("2014-01-01"), as.Date("2014-12-31"), by = "day")
seas <-  getSeason(dag)
test <- data.frame(zz,dag,seas)

ggplot(data=test, aes(x=dag,ymax=zz,ymin=0,fill=seas))+
  geom_ribbon() +
  scale_fill_manual(values = c('winter2014'='red','spring2014'='blue','summer2014'='green','fall2014'='yellow','winter2015'='red'))

<强>结果

Answer 4

您可以在两个冬季之间的某处添加虚拟缺失值：

test[nrow(test), ] <- list(NA, as.Date("2014-6-1"), "Winter")

ggplot(data=test, aes(x=dag,ymax=zz,ymin=0,fill=seas))+
  geom_ribbon()