r - 两个时代系列之间的颜色区域

Question

我想知道如何为两个时间序列之间的区域着色。

我用以下代码创建了一个图表：

annee = c("2018-05-01", "2018-04-30", "2018-04-29", "2018-04-28" ,"2018-04-27", "2018-04-26", "2018-04-25", "2018-04-24", "2018-04-23", "2018-04-22", "2018-04-21", "2018-04-20", "2018-04-19", "2018-04-18", "2018-04-17", "2018-04-16","2018-04-15", "2018-04-14", "2018-04-13", "2018-04-12", "2018-04-11", "2018-04-10", "2018-04-09", "2018-04-08", "2018-04-07", "2018-04-06", "2018-04-05", "2018-04-04")  

mean = c(8.519167,  9.776667, 12.222083, 13.131250, 14.100000, 12.697917, 16.212500, 16.306667, 15.775417, 17.623750, 17.972083, 17.370000, 17.143048, 15.642917, 13.629167, 12.362083, 12.315833, 11.052917,  9.589167, 8.639167,  8.958750,  9.247500, 11.083750, 12.591667, 13.534583, 10.928750,  9.026667, 10.365833)

z = c(13.148313, 12.323909, 11.909722, 11.625099, 12.135710, 12.534321, 13.316563, 14.062893, 14.244242, 13.623607, 13.440273, 12.869940, 12.583036, 12.657410, 12.901756, 13.228886, 13.829746, 13.790623, 13.805771, 13.610033, 12.621674, 11.360067, 10.022024,  8.929100,  8.359593,  8.035119,  7.409528,  7.145040)   

m = data.frame(annee, mean, z)
                                      
plot_ly(m) %>% add_lines(type = 'scatter', mode = "lines", 
        name = "test", yaxis = 'y2',
        x = ~date, y = ~mean,
        line = list(color = '#CC79A7')) %>%add_lines(type = 'scatter', mode = "lines", 
        name = "test", yaxis = 'y2',
        x = ~date, y = ~z,
        line = list(color = 'red'))    

看起来像这样：

我希望结果看起来像这样：

标签： rggplot2graphtime-seriesr-plotly

Answer 1

事实证明，这非常具有挑战性。关键问题是我们需要确定两条线的交点。

我修改了@ken 的答案以使用spandrgeos包来查找交点。

library(sp)
library(rgeos)
library(ggplot2)
#Convert character dates to integer, otherwise we can't
#calculate fractions of a date for the intersection
m$annee <- as.integer(as.Date(m$annee))
#Create sp Lines
zline <- Line(cbind(m$annee, m$z))
meanline <- Line(cbind(m$annee, m$mean))
#Create sp Line Lists
zsl <- SpatialLines(list(Lines(zline, ID = "1")), proj4string = CRS("+init=epsg:4269"))
meansl <- SpatialLines(list(Lines(meanline, ID = "1")), proj4string = CRS("+init=epsg:4269"))
#Find intersections 
intersections <- gIntersection(zsl,meansl,byid = TRUE)

#Pepare intersections
intersections <- as.data.frame(intersections@coords)
names(intersections) <- c("annee","z")
intersections$mean <- intersections$z

#Combine intersections with original data
combinedm <- rbind(m,intersections)

从那里，我们可以使用geom_ribbon.

ggplot(data = combinedm, aes(x = annee)) +
  geom_line(aes(y = mean), color = '#CC79A7') +
  geom_line(aes(y = z), color = 'red') +
  geom_ribbon(data = combinedm[combinedm$z >= combinedm$mean,],
              aes(ymax = z, ymin = mean), fill = "firebrick3", 
              alpha = 0.5) +
  geom_ribbon(data = combinedm[combinedm$z <= combinedm$mean,],
              aes(ymax = mean, ymin = z), fill = "cornflowerblue", 
              alpha = 0.5) +
  scale_x_continuous(labels = \(x)as.Date(x, origin='1970-01-01')) 
  #Using a custom labeling function to convert the integer breaks to actual dates