在 ggplot2 中创建从上到下的 fade/gradient geom_density

Question

我想创建一个具有从上到下渐变的 geom_density。这只是为了美观。比如这个剧情的淡入淡出就是我要实现的：

最小工作示例：

加载库：

library(ggplot2)
library(dplyr)

这是一些数据

dat <- structure(list(date = structure(c(18335, 18336, 18337, 18338, 
                                         18339, 18340, 18341, 18342, 18343, 18344, 18345, 18346, 18347, 
                                         18348, 18349, 18350, 18351, 18352, 18353, 18354, 18355, 18356, 
                                         18357, 18358, 18359, 18360, 18361, 18362, 18363, 18364, 18365, 
                                         18366, 18367, 18368, 18369, 18370, 18371, 18372, 18373, 18374, 
                                         18375, 18376, 18377, 18378, 18379, 18380, 18381, 18382, 18383, 
                                         18384, 18385, 18386, 18387, 18388, 18389, 18390, 18391, 18392, 
                                         18393, 18394, 18395, 18396, 18397, 18398, 18399, 18400, 18401, 
                                         18402, 18403, 18404, 18405, 18406, 18407, 18408, 18409, 18410, 
                                         18411, 18412, 18413, 18414, 18415, 18416, 18417, 18418, 18419, 
                                         18420, 18421, 18422, 18423, 18424, 18425, 18426, 18427, 18428, 
                                         18429, 18430, 18431, 18432, 18433, 18434, 18435, 18436, 18437, 
                                         18438, 18439, 18440, 18441, 18442), class = "Date"),
                      n = c(49L, 
                            121L, 152L, 142L, 137L, 138L, 129L, 144L, 187L, 245L, 337L, 363L, 
                            360L, 374L, 386L, 399L, 404L, 395L, 402L, 398L, 389L, 392L, 409L, 
                            419L, 402L, 389L, 414L, 391L, 388L, 377L, 402L, 398L, 398L, 398L, 
                            395L, 396L, 275L, 386L, 393L, 394L, 322L, 383L, 388L, 397L, 343L, 
                            399L, 384L, 366L, 358L, 375L, 378L, 373L, 368L, 377L, 369L, 352L, 
                            360L, 367L, 363L, 357L, 357L, 347L, 329L, 361L, 340L, 334L, 359L, 
                            335L, 325L, 322L, 297L, 326L, 350L, 323L, 343L, 275L, 232L, 226L, 
                            234L, 222L, 221L, 191L, 204L, 174L, 138L, 76L, 58L, 52L, 32L, 
                            29L, 27L, 21L, 22L, 20L, 13L, 13L, 10L, 12L, 3L, 3L, 3L, 4L, 
                            3L, 3L, 3L, 3L, 3L, 3L)), row.names = c(NA, -108L),
                 class = c("tbl_df", 
                           "tbl", "data.frame")) %>%
  uncount(n)

这是geom_density我想褪色的：

ggplot(dat,
         aes(date)) +
    geom_density(stat = "density",
                 color = "black",
                 fill = "black",
                 lwd = .75)

这是上面代码生成的图：

Answer 1

我认为 vanilla ggplot2 目前不支持此功能。一个可能的解决方案是查看 ggpattern 包 (https://github.com/coolbutuseless/ggpattern)，但这不会安装在我的机器上。在 R4.1（开发中）中，这应该会变得容易得多。

这是一个自制函数，它使用 polyclip 对多边形进行切片，然后您可以使用它来绘制密度图。您可以通过设置 n = ... 来控制它的平滑程度，并通过设置 alpha 比例范围来控制淡入淡出的强度。我使用了不同的数据，因为我找不到 uncount 函数。

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

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

dens <- density(faithful$eruptions)
grad <- fade_polygon(dens$x, dens$y)

ggplot(grad, aes(x, y)) +
  geom_line(data = data.frame(x = dens$x, y = dens$y)) +
  geom_polygon(aes(alpha = value, group = id),
               fill = "blue") +
  scale_alpha_continuous(range = c(0, 1))

^{由 reprex package (v0.3.0)}

于 2020-11-05 创建

在 ggplot2 中创建从上到下的 fade/gradient geom_density

Create top-to-bottom fade/gradient geom_density in ggplot2

r

linear-gradients

ggplot2