根据高度为脊线添加颜色渐变

Question

我想根据区域的高度而不是根据 X 轴使用渐变填充颜色为我的山脊线图着色。应该是这样的：

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')

但这里不是根据 x 轴填充渐变，而是希望对所有曲线使用相同的垂直渐变，因此曲线最高，颜色最暗。所以峰的颜色会更深，而基线附近的颜色会更浅。

PD:my plot 我用geom_ridgeline()代替了geom_density_ridges_gradient()但是我觉得这个例子更能说明问题。并且还有负值。

PD2：我知道有一个类似的问题“已解决”. But is obsolete, since if you check the github from the suggested package there is an issue 指出所需的功能不起作用，因为它基于另一个已弃用的功能。

Answer 1

您想根据各个轨迹的 density 为脊线着色，因此您必须访问该统计信息。幸运的是，ggridges 允许使用 stat='density' 选项和 ..density.. 输入美学。

代码：

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')

产量：

Answer 2

仍然有效，前提是您绕过 encode_pattern_params_as_hex_colour() 函数并自己创建图案渐变（通过 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

一个经常被人们忽视的选项是，只要你能用多边形表示，你几乎可以在 ggplot2 中绘制任何东西。缺点是工作量大。

以下方法模仿了我给定的答案，但进行了一些调整以更一致地处理多种密度。它完全放弃了 {ggridges} 方法。

下面的函数可用于沿 y 位置分割任意多边形。

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)
}

接下来，我们需要手动计算每个月的密度，并对每个密度应用上述函数。

# 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)

接下来，我们需要将有关月份的信息添加回数据中。

# 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)

最后我们用 vanilla ggplot2 绘制这些多边形。 (y / ymax) * scale 执行与 ggridges 执行的操作类似的缩放，并每月从彼此添加 month_id 偏移量。

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()

^{由 reprex package (v2.0.1)}

于 2021-09-12 创建

根据高度为脊线添加颜色渐变

Add color gradient to ridgelines according to height

r

ggplot2

ggridges