Gradient fill for geom_bar scaled relative to each bar and not mapped to a variable

Question

My goal is to reproduce this plot, and my problem is reproducing the gradient fill in each bar.

ADDED after COMMENT The good comment of @PavoDive directs us to a question that basically says "You can't do it with ggplot2 and furthermore it is a bad idea even if you could do it." Agreed as to it being a poor graphical choice, but for didactic purposes I wanted to re-create the original and then show improvements. So, is there a programming solution nevertheless?

With the data that follows the ggplot code I have gotten close, other than the consistent gradient coloring that is the same for each bar (and the tiny tick marks). But my efforts result in bars that are filled to match the y value, while in the original plot each bar is filled with the same pattern. How do I achieve that effect?

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

Data

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

This may be acheived with functions from package gridSVG. I use a stripped-down version of your example with only the most necessary parts for the actual problem:

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

You find more gridSVG examples here, here, and here.

Answer 2

Here is an option, using geom_path with a scaled y to color by instead of bars. This creates some new data (dat), sequences from 0 to each df$y value (length 100 here, in column dat$y). Then, a scaled version of each sequence is created (from 0 to 1), that is used as the color gradient (called dat$scaled). The scaling is done by simply dividing each sequence by its maximum value.

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