r - How to assign a Colour Scale based on Y-axis in ggplot

Question

I am trying to assign a colour scale/gradient to some violin plots based on the y-axis value of Income. However, I only get a white violin plot. I can change the colour based on state.region but not Income.

Data

USA.states <- data.frame(state.region,state.x77)

Code

p <- ggplot(USA.states,aes(x=state.region,y=Income,fill=Income))+
geom_violin(trim = F,)+
ggtitle("Violin plot of income and Population")

p + scale_fill_gradient(low="red",high="blue")

I assigned the fill to Income but it just ends up filled with white.

Answer 1

You can create a pseudo-fill from segments, and you can create those from the underlying data (in the ggplot_built object) directly.

If you want an additional polygon outline, you would still need to create the polygons manually though, using x and y coordinates as calculated for the segments. (There is certainly a cleverer way to put this into a data frame than below, so don't take this as gospel).

Of another note, the violins in the original plot seem to be scaled, but I don't exactly understand how, so I just scaled it with a constant which I found with some trial and error.

library(tidyverse)

USA.states <- data.frame(state.region,state.x77)
p <- ggplot(USA.states,aes(x=state.region,y=Income,fill=Income))+
  geom_violin(trim = F)

mywidth <- .35 # bit of trial and error
# This is all you need for the fill: 
vl_fill <- data.frame(ggplot_build(p)$data) %>%
  mutate(xnew = x- mywidth*violinwidth, xend = x+ mywidth*violinwidth) 

# Bit convoluted for the outline, need to be rearranged: the order matters
vl_poly <- 
  vl_fill %>% 
  select(xnew, xend, y, group) %>%
  pivot_longer(-c(y, group), names_to = "oldx", values_to = "x") %>% 
  arrange(y) %>%
  split(., .$oldx) %>%
  map(., function(x) {
    if(all(x$oldx == "xnew")) x <- arrange(x, desc(y))
    x
    }) %>%
  bind_rows()

ggplot() +
  geom_polygon(data = vl_poly, aes(x, y, group = group), 
               color= "black", size = 1, fill = NA) +  
  geom_segment(data = vl_fill, aes(x = xnew, xend = xend, y = y, yend = y,
                                   color = y))  

^{Created on 2021-04-14 by the reprex package (v1.0.0)}