geom_bar 的渐变填充相对于每个条进行缩放，并且未映射到变量

Question

我的目标是重现这个图，我的问题是重现每个条中的渐变填充。

评论后添加 @PavoDive 的好评将我们引向了一个问题，基本上是说“你不能用 ggplot2 做到这一点，而且即使你能做到，这也是一个坏主意。”同意这是一个糟糕的图形选择，但出于教学目的，我想重新创建原始版本，然后展示改进。那么，有没有编程解决方案呢？

使用

ggplot

代码后面的数据，除了每个条形（以及微小的刻度线）相同的一致渐变颜色之外，我已经接近了。但我的努力导致条形图被填充以匹配 y 值，而在原始图中，每个条形图都填充了相同的模式。怎样才能达到这样的效果呢？

ggplot(df, aes(x = x, y = y, fill = y)) +
  geom_hline(yintercept = seq(0, .35, .05), color = "grey30", size = 0.5, linetype = "solid") +
  geom_bar(stat = "identity", width = 0.4) +
  scale_fill_gradient(low='green4', high='green1', guide = FALSE) +
  theme(legend.position = "none") +
  theme_minimal() +
  geom_text(data = df, aes(label = scales::percent(y), vjust = -.5)) +
  theme(axis.text.y = element_blank()) +
  theme(axis.ticks = element_blank()) +
  labs(y = "", x = "") +
  ggtitle("Question 15: Do you feel prepared to comply with the upcoming December
          2015 updated requirements of the FRCP that relate to ediscovery") +
  theme(plot.title = element_text(face = "bold", size = 18)) +
  theme(panel.border = element_blank())

数据

df <- data.frame(x = c("Prepared", "Somewhat\nprepared", "Not prepared", "Very prepared"),
                 y = c(.32, .31, .20, .17))
df$x <- factor(df$x, levels = c("Prepared", "Somewhat\nPrepared", "Not Prepared", "Very Prepared"))

Answer 1

这可以通过包

gridSVG

中的功能来实现。我使用您示例的精简版本，仅包含实际问题最必要的部分：

# load additional packages
library(grid)
library(gridSVG)

# create a small data set
df <- data.frame(x = factor(1:3), y = 1:3)

# a basic bar plot to be modified
ggplot(data = df, aes(x = x, y = y)) +
  geom_bar(stat = "identity") 

# create a linear color gradient
cols <- linearGradient(col = c("green4", "green1"),
                       x0 = unit(0.5, "npc"), x1 = unit(0.5, "npc"))

# create a definition of a gradient fill
registerGradientFill(label = "cols", gradient = cols)

# list the names of grobs and look for the relevant geometry 
grid.ls()
# GRID.gTableParent.76
# ...snip...
#  panel.3-4-3-4
#    geom_rect.rect.2 # <~~~~ this is the grob! Note that the number may differ

# apply the gradient to each bar
grid.gradientFill("geom_rect.rect", label = rep("cols", length(unique(df$x))),
                  group = FALSE, grep = TRUE)

# generate SVG output from the grid graphics
grid.export("myplot.svg")

您可以在

此处

、此处和此处找到更多gridSVG示例。

Answer 2

这里有一个选项，使用

geom_path

和缩放的 y 代替条形来着色。这会创建一些新数据 (

dat

)，从 0 到每个

df$y

值的序列（此处长度为 100，在列

dat$y

中）。然后，创建每个序列的缩放版本（从 0 到 1），用作颜色渐变（称为

dat$scaled

）。只需将每个序列除以其最大值即可完成缩放。

## Make the data for geom_path
mat <- mapply(seq, 0, df$y, MoreArgs = list(length=100))                         # make sequences 0 to each df$y
dat <- stack(data.frame(lapply(split(mat, col(mat)), function(x) x/tail(x,1))))  # scale each, and reshape
dat$x <- rep(df$x, each=100)                                                     # add the x-factors
dat$y <- stack(as.data.frame(mat))[,1]                                           # add the unscaled column
names(dat)[1] <- "scaled"                                                        # rename

## Make the plot
ggplot(dat, aes(x, y, color=scaled)) +                                           # use different data
  ## *** removed some code here ***
  geom_hline(yintercept = seq(0, .35, .05), color = "grey30", size = 0.5, linetype = "solid") +
  theme(legend.position = "none") +
  theme_minimal() +
  geom_text(data = df, aes(label = scales::percent(y), vjust = -.5), color="black") +
  theme(axis.text.y = element_blank()) +
  theme(axis.ticks = element_blank()) +
  labs(y = "", x = "") +
  ggtitle("Question 15: Do you feel prepared to comply with the upcoming December
          2015 updated requirements of the FRCP that relate to ediscovery") +
            theme(plot.title = element_text(face = "bold", size = 18)) +
            theme(panel.border = element_blank()) +
  ## *** Added this code ***            
  geom_path(lwd=20) +
  scale_color_continuous(low='green4', high='green1', guide=F)

Answer 3

使用

ggplot2 >= 3.5.0

（和

R >= 4.2.0

）增加了对渐变填充的支持，现在可以更轻松地实现这一点。

与@Henrik 的方法类似，这需要首先使用例如创建渐变填充

grid::linearGradient

然后可以传递给

fill=

的

geom_bar

参数：

library(ggplot2)

packageVersion("ggplot2")
#> [1] '3.5.0'

grad_ungroup <- grid::linearGradient(c("green4", "green1"), group = FALSE)

ggplot(df, aes(x = x, y = y, fill = y)) +
  geom_hline(
    yintercept = seq(0, .35, .05),
    color = "grey30", size = 0.5, linetype = "solid"
  ) +
  geom_bar(stat = "identity", width = 0.4, fill = grad_ungroup) +
  theme(legend.position = "none") +
  theme_minimal() +
  geom_text(data = df, aes(label = scales::percent(y), vjust = -.5)) +
  theme(axis.text.y = element_blank()) +
  theme(axis.ticks = element_blank()) +
  labs(y = "", x = "") +
  ggtitle("Question 15: Do you feel prepared to comply with the upcoming December
          2015 updated requirements of the FRCP that relate to ediscovery") +
  theme(plot.title = element_text(face = "bold", size = 18)) +
  theme(panel.border = element_blank())