使用ggplot2渐变填充小提琴图

Question

I want to gradient fill a violin plot based on the density of points in the bins (blue for highest density and red for lowest).

I have generated a plot using the following commands but failed to color it based on density (in this case the width of the violin. I also would like to generate box plots with similar coloring).

library("ggplot2")
data(diamonds)

ggplot(diamonds, aes(x=cut,y=carat)) + geom_violin() 

Answer 1

to change the colour of the violin plot you use fill = variable, like this:

ggplot(diamonds, aes(x=cut,y=carat)) + geom_violin(aes(fill=cut)) 

same goes for boxplot

ggplot(diamonds, aes(x=cut,y=carat)) + geom_boxplot(aes(fill=cut)) 

but whatever value you have has to have the same value for each cut, that is, if you wanted to use for example mean depth/cut as the color variable you would have to code it.

with dplyr group your diamonds by cut and with summarize get the mean depth (or any other variable)

library(dplyr)
diamonds_group <- group_by(diamonds, cut)
diamonds_group <- summarize(diamonds_group, Mean_Price = mean(price))

Then I used diamonds2 as a copy of diamonds to then manipulate the dataset

diamonds2 <- diamonds

I merge both dataframes to get the Mean_Depth as a variable in diamonds2

diamonds2 <- merge(diamonds2, diamonds_group)

And now I can plot it with mean depth as a color variable

ggplot(diamonds2, aes(x=cut,y=carat)) + geom_boxplot(aes(fill=Mean_Price)) + scale_fill_gradient2(midpoint = mean(diamonds2$price))

Answer 2

Just answered this for another thread , but believe it's possibly more appropriate for this thread. You can create a pseudo-fill by drawing many segments. You can get those directly from the underlying data in the ggplot_built object.

If you want an additional polygon outline ("border"), you'd need to create this from the x/y coordinates. Below one option.

library(tidyverse)

p <- ggplot(diamonds, aes(x=cut,y=carat)) + geom_violin() 

mywidth <- .35 # bit of trial and error

# all you need for the gradient fill 
vl_fill <- data.frame(ggplot_build(p)$data) %>%
  mutate(xnew = x- mywidth*violinwidth, xend = x+ mywidth*violinwidth) 

# the outline is a bit more convoluted, as 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 = violinwidth))  

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