Градиентная заливка для geom_bar, масштабированная относительно каждого бара, и не отображаемая на переменную

Моя цель - воспроизвести этот сюжет, и моя проблема заключается в воспроизведении градиентной заливки в каждом баре.

ДОБАВЛЕНО после COMMENT Хороший комментарий @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"))

Ответ 1

Вот вариант, используя 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)

введите описание изображения здесь

Ответ 2

Это может быть выполнено с помощью функций из пакета 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 примеров здесь, здесь и здесь.