Use a gradient fill under a facet wrap of density curves in ggplot in R?

user_3447708 0
Viewed 106

Similar questions have been asked before in other forms. Some can be found here and here. However, I cant seem to adapt them when using a facet wrap displaying multiple density plots.

I tried adapting the other examples, but failed... I also tried using the ggpattern package, but when there is a large amount of data, it takes several minutes on my machine to create a plot.

I am trying to create a gradient under the density curve... but with the gradient pointing down. Something like in the example image below: example gradient density plot

Some example data to work with:

library(ggplot2)
set.seed(321)

# create data
varNames <- c("x1", "x2", "x3")
df <- data.frame(
  var = sample(varNames, 100, replace = T),
  val = runif(100)
)

# create plot
ggplot(df, aes(x = val)) +
  geom_density(aes(colour = var, fill = var)) +
  facet_wrap(~var) +
  theme_bw() +
  theme(legend.position = "none")
ggplot2 r
1 Answers

You can use teunbrand's function, but you will need to apply it to each facet. Here simply looping over it with lapply

library(tidyverse)
library(polyclip)
#> polyclip 1.10-0 built from Clipper C++ version 6.4.0

## This is teunbrands function copied without any change!!
## from https://stackoverflow.com/a/64695516/7941188
fade_polygon <- function(x, y, n = 100) {
  poly <- data.frame(x = x, y = y)
  
  # Create bounding-box edges
  yseq <- seq(min(poly$y), max(poly$y), length.out = n)
  xlim <- range(poly$x) + c(-1, 1)
  
  # Pair y-edges
  grad <- cbind(head(yseq, -1), tail(yseq, -1))
  # Add vertical ID
  grad <- cbind(grad, seq_len(nrow(grad)))
  
  # Slice up the polygon
  grad <- apply(grad, 1, function(range) {
    # Create bounding box
    bbox <- data.frame(x = c(xlim, rev(xlim)),
                       y = c(range[1], range[1:2], range[2]))
    
    # Do actual slicing
    slice <- polyclip::polyclip(poly, bbox)
    
    # Format as data.frame
    for (i in seq_along(slice)) {
      slice[[i]] <- data.frame(
        x = slice[[i]]$x,
        y = slice[[i]]$y,
        value = range[3],
        id = c(1, rep(0, length(slice[[i]]$x) - 1))
      )
    }
    slice <- do.call(rbind, slice)
  })
  # Combine slices
  grad <- do.call(rbind, grad)
  # Create IDs
  grad$id <- cumsum(grad$id)
  return(grad)
}

## now here starts the change, loop over your variables. I'm creating the data frame directly instead of keeping the density object
dens <- lapply(split(df, df$var), function(x) {
  dens <- density(x$val)
  data.frame(x = dens$x, y = dens$y)
}
)
## we need this one for the plot, but still need the list 
dens_df <- bind_rows(dens, .id = "var")

grad <- bind_rows(lapply(dens, function(x) fade_polygon(x$x, x$y)), .id = "var")

ggplot(grad, aes(x, y)) +
  geom_line(data = dens_df) +
  geom_polygon(aes(alpha = value, group = id),
               fill = "blue") +
  facet_wrap(~var) +
  scale_alpha_continuous(range = c(0, 1))

Created on 2021-12-05 by the reprex package (v2.0.1)

user_79411880
Related