Combine 2d density plot with ribbon

Question

I have a dataframe with 20 dates, and for each date, 50 values. I am trying to plot a 2d density plot of these values, that remains inside the minimum-maximum ribbon. An exemple of what I want is there :

I know how to have a 2d density plot, as well as a ribbon, but not to connect both together. This is my attempt :

require(ggplot2)
require(dplyr)
require(RColorBrewer)

set.seed(248)

##Create reproducible example
Chass <- data.frame(nb=rep(1:50, 10), x=rep(1:10, each=50), val=c(sample(seq(7,9,0.1), size=50, replace = T),
                                                                  sample(seq(17,19,0.1), size=50, replace = T),
                                                                  sample(seq(10,12,0.1), size=50, replace = T),
                                                                  sample(seq(7,10,0.1), size=50, replace = T),
                                                                  sample(seq(6,18,0.1), size=50, replace = T),
                                                                  sample(seq(5,11,0.1), size=50, replace = T),
                                                                  sample(seq(6,13,0.1), size=50, replace = T),
                                                                  sample(seq(2,7,0.1), size=50, replace = T),
                                                                  sample(seq(4,8,0.1), size=50, replace = T),
                                                                  sample(seq(3,16,0.1), size=50, replace = T)))

##Compute statistics for the ribbon
Chass_stats <- summarise(group_by(Chass, x), min=min(val, na.rm=T), mean=mean(val, na.rm=T), max=max(val, na.rm=T))

## Get both
p1 <- ggplot(Chass, aes(x=x, y=val))
p1 <- (p1
       + theme_bw()
       + ggtitle("Chass")
       + geom_density_2d_filled(aes(fill = ..level..), contour_var = "ndensity", bins = 10)
       + geom_line(data=Chass_stats, aes(y=mean), color="black")
       + geom_line(data=Chass_stats, aes(y=min), color="black", linetype="dashed")
       + geom_line(data=Chass_stats, aes(y=max), color="black", linetype="dashed")
       + scale_fill_manual(name = "% ", values=colorRampPalette(brewer.pal(n = 9, name = "YlOrBr"))(10))
       + ylab("Value")
       + theme(axis.title.x = element_blank()))

p1

which gives

The density plot does not respect the temporal coherence needed and goes outside of the boundaries... does someone can help with that ?

Thanks !

Answer 1

You could use the upper and lower bounds of the ribbon as lower and upper bounds of masking ribbons with infinite ymin and ymax. This would mask out the non-ribbon areas. It's a bit hacky, but the end result is nice and it is far easier than calculating everything manually.

Laying the panel grid over the data makes it functionally identical to the original image (apart from the palette and lower-res data)

ggplot(Chass, aes(x = x)) +
  geom_density_2d_filled(aes(y = val, fill = after_stat(level)), 
                        contour_var = "ndensity", bins = 10, color = "black",
                        linewidth = 0.2) +
  geom_line(data = Chass_stats, aes(y = mean), color = "black") +
  geom_ribbon(data = Chass_stats, aes(ymax = min, ymin = -Inf), 
             fill = "white", color = "gray30", linewidth = 0.2) +
  geom_ribbon(data = Chass_stats, aes(ymax = max, ymin = Inf), 
             fill = "white", color = "gray30", linewidth = 0.2) +
  scale_fill_manual(name = "% ", 
                  values = colorRampPalette(
                    brewer.pal(n = 9, name = "YlOrBr"))(10)) +
  coord_cartesian(expand = FALSE) +
  theme_minimal() +
  ggtitle("Chass") +
  ylab("Value") +
  theme(axis.title.x = element_blank(), 
       panel.grid = element_line(linewidth = 0.2, color = "gray30"),
       panel.ontop = TRUE)