Add color gradient to ridgelines according to height

Question

I want to color my ridgeline plot with gradient fill colors depending on the height of the area instead of depending on the X axis. It would be somthing like this:

library(ggplot2)
library(ggridges)   
ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`, fill = stat(x))) +
      geom_density_ridges_gradient(scale = 3, size = 0.3, rel_min_height = 0.01) +
      scale_fill_viridis_c(name = "Temp. [F]", option = "C") +
      labs(title = 'Temperatures in Lincoln NE')

But here instead of fill the gradient according to the x axis I'm looking to use the same vertical gradient for all the curves so the highest the curve, the darkest the color. So the peaks would have a darker color while near the baseline would be lighter.

PD:my plot I use geom_ridgeline() instead of geom_density_ridges_gradient() but I think this example is more clear to illustrate the problem. And also have negative values.

PD2:I know there is a similar question "solved" here. But is obsolete, since if you check the github from the suggested package there is an issue stating that the function needed doesn't work because is based on another deprecated function.

Answer 1

An option often overlooked by people is that you can pretty much draw anything in ggplot2 as long as you can express it in polygons. The downside is that it is a lot more work.

The following approach mimics my answer given here but adapted a little bit to work more consistently for multiple densities. It abandons the {ggridges} approach completely.

The function below can be used to slice up an arbitrary polygon along the y-position.

library(ggplot2)
library(ggridges)
library(polyclip)

fade_polygon <- function(x, y, yseq = seq(min(y), max(y), length.out = 100)) {
  poly <- data.frame(x = x, y = y)
  
  # Create bounding-box edges
  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)
}

Next, we need to calculate densities manually for every month and apply the function above for each one of those densities.

# Split by month and calculate densities
densities <- split(lincoln_weather, lincoln_weather$Month)
densities <- lapply(densities, function(df) {
  dens <- density(df$`Mean Temperature [F]`)
  data.frame(x = dens$x, y = dens$y)
})

# Extract x/y positions
x <- lapply(densities, `[[`, "x")
y <- lapply(densities, `[[`, "y")

# Make sequence to max density
ymax <- max(unlist(y))
yseq <- seq(0, ymax, length.out = 100) # 100 can be any large enough number

# Apply function to all densities
polygons <- mapply(fade_polygon, x = x, y = y, yseq = list(yseq),
                   SIMPLIFY = FALSE)

Next, we need to add the information about Months back into the data.

# Count number of observations in each of the polygons
rows <- vapply(polygons, nrow, integer(1))
# Combine all of the polygons
polygons <- do.call(rbind, polygons)
# Assign month information
polygons$month_id  <- rep(seq_along(rows), rows)

Lastly we plot these polygons with vanilla ggplot2. The (y / ymax) * scale does a similar scaling to what ggridges does and adding the month_id offsets each month from oneanother.

scale <- 3
ggplot(polygons, aes(x, (y / ymax) * scale + month_id, 
                     fill = value, group = interaction(month_id, id))) +
  geom_polygon(aes(colour = after_scale(fill)), size = 0.3) +
  scale_y_continuous(
    name = "Month",
    breaks = seq_along(rows),
    labels = names(rows)
  ) +
  scale_fill_viridis_c()

^{Created on 2021-09-12 by the reprex package (v2.0.1)}

Answer 2

The linked answer is still valid, provided you bypass the encode_pattern_params_as_hex_colour() function and create the pattern gradient yourself (via svgpatternsimple::create_pattern_gradient()):

library(tidyverse)
devtools::install_github("coolbutuseless/devout")
devtools::install_github("coolbutuseless/devoutsvg")
devtools::install_github("coolbutuseless/minisvg")
devtools::install_github("coolbutuseless/poissoned")
devtools::install_github("coolbutuseless/svgpatternsimple")
library(svgpatternsimple)
library(ggridges)

gradient_pattern <- svgpatternsimple::create_pattern_gradient(
  id      = "p1",                                  # HTML/SVG id to assign to this pattern
  angle   = 90,                                    # Direction of the gradient
  colour1 = viridis::viridis(1, direction = -1),   # Starting colour
  colour2 = viridis::viridis(1)                    # Final colour
)

my_pattern_list <- list(
  `#000001` = list(fill = gradient_pattern)
)

devoutsvg::svgout(filename = "test.svg", pattern_list = my_pattern_list)
ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`)) +
  geom_density_ridges_gradient(scale = 3, size = 0.3,
                               rel_min_height = 0.01,
                               fill = '#000001') +
  labs(title = 'Temperatures in Lincoln NE')
dev.off()

Answer 3

You want to color the ridges according to the density of the individual traces, so you have to get access to that statistic. Fortunately, ggridges allows that with the stat='density' option and the ..density.. input to the asthetic.

The code:

ggplot(lincoln_weather, aes(x = `Mean Temperature [F]`, y = `Month`, fill = ..density.., height=..density..)) +
  geom_density_ridges_gradient(scale = 3, size = 0.3, rel_min_height = 0.01, stat='density') +
  scale_fill_viridis_c(name = "Temp. [F]", option = "C") +
  labs(title = 'Temperatures in Lincoln NE')

Yields: