如何在ggplot2图中突出显示时间序列项

Question

I wish to highlight segments above or below a certain value in a time series by a unique colour or a shape. In the example data I am decomposing a mortality time series into its components. My goal is to highlight the segments when the mortality in the trend component falls below 35 (deep between 1997 and 2000) and when the residual component is above 100 (the spike). I have tried to use annotate, but that did not produce what I wanted.

#Load library and obtain data

library(gamair) 
library(tsModel)
library(ggplot2)
library(reshape2)
data<-data(chicago)

## create variables, decompose TS
chicago$date<-seq(from=as.Date("1987-01-01"), to=as.Date("2000-12-31"),length=5114)
data<- chicago[,c("date","death")]
mort <- tsdecomp(data$death, c(1, 2, 15, 5114))

## Convert matrix to df, rename, melt
df<-as.data.frame(mort)
names(df)[1] <- "Trend"
names(df)[2] <- "Seasonal"
names(df)[3] <- "Residual"
df$date<-seq(as.Date("1987-01-01"), as.Date("2000-12-31"), "day")
meltdf <- melt(df,id="date")

##  Plot 

ggplot(meltdf,aes(x=date,y=value,colour=variable,group=variable)) + geom_line() +
theme_bw() +
ylab("") + xlab("") + 
facet_grid(variable ~ . , scales = "free") +
theme(legend.position = "none") 
annotate("rect", xmin=1995-01-01,xmax=1996-01-01,ymin= 10, ymax=300, alpha = .2,fill="blue")

Answer 1

Well, this works but I must admit it's more work that I'd hoped.

get.box <- function(data) {
  rng <- range(data$date) + c(-50,50)
  z   <- meltdf[meltdf$date>=rng[1] & meltdf$date <=rng[2] & meltdf$variable==unique(data$variable),]
  data.frame(variable=unique(z$variable),
             xmin=min(z$date),xmax=max(z$date),ymin=min(z$value),ymax=max(z$value))
}
hilight.trend <- get.box(with(meltdf,meltdf[variable=="Trend" & value<35,]))
hilight.resid <- get.box(with(meltdf,meltdf[variable=="Residual" & value>100,]))
ggplot(meltdf,aes(colour=variable,group=variable)) + 
  geom_line(aes(x=date,y=value)) +
  theme_bw() +
  ylab("") + xlab("") + 
  facet_grid(variable ~ . , scales = "free") +
  theme(legend.position = "none") +
  geom_rect(data=hilight.trend, alpha=0.2, fill="red",
            aes(xmax=xmax,xmin=xmin,ymax=ymax,ymin=ymin)) +
  geom_rect(data=hilight.resid, alpha=0.2, fill="blue", 
            aes(xmax=xmax,xmin=xmin,ymax=ymax,ymin=ymin))

You can't really use annotate(...) with facets, because you will get the same annotation on all the facets. So you're left with something like geom_rect(...) . The problem here is that geom_rect(...) draws a rectangle for every row in the data . So you need to create an auxiliary dataset with just one row for each variable , containing the x- and y- min and max.