使用ggplot2梯度填充小提琴图

Question

我想根据箱中点的密度梯度填充小提琴图（蓝色表示最高密度，红色表示最低密度）。

我使用以下命令生成了一个图，但未能根据密度（在本例中为小提琴的宽度）为其着色。我也想生成具有类似颜色的箱线图。

library("ggplot2")
data(diamonds)

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

Answer 1

刚刚为另一个线程回答了这个问题，但相信它可能更适合这个线程。您可以通过绘制许多线段来创建伪填充。您可以直接从 ggplot_built 对象中的基础数据中获取这些数据。

如果您想要额外的多边形轮廓（“边界”），您需要从 x/y 坐标创建它。下面有一个选项。

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

由 ^{reprex 包于 2021-04-14 创建（v1.0.0）}

Answer 2

要更改小提琴图的颜色，请使用 fill = 变量，如下所示：

ggplot(diamonds, aes(x=cut,y=carat)) + geom_violin(aes(fill=cut)) 箱线图也是如此

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

但是无论您拥有什么值，每次切割都必须具有相同的值，也就是说，如果您想使用平均深度/切割作为颜色变量，则必须对其进行编码。

使用 dplyr 按切工对钻石进行分组，并使用 summarize 获取平均深度（或任何其他变量）

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

然后我使用 Diamonds2 作为 Diamonds 的副本来操作数据集

diamonds2 <- diamonds 我合并两个数据帧以获得 Mean_Depth 作为 Diamonds2 中的变量

diamonds2 <- merge(diamonds2, diamonds_group) 现在我可以用平均深度作为颜色变量来绘制它

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

Answer 3

根据@tjebo 的回答和@CyG 的请求，我简化了生成带有渐变填充的小提琴图的代码。为此，我重新使用

geom_violin

 生成轮廓并调整 

mywidth

 参数以补偿宽度差异。

唯一棘手的部分是确保生成单独的小提琴图，并且 x 轴显示为离散的，即使 x 轴是连续的（geom_segment 需要）。为此，我将

geom_violin

 的填充美学设置为分类变量 

cut

，并将 

cut

 转换为整数，以在 

x

 中设置 

aes()

。

library(tidyverse)
library(viridisLite)

mywidth <- .45 # bit of trial and error

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

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

breaks <- unique(as.integer(df_input$cut))
labels <- unique(df_input$cut)

ggplot() +
  geom_segment(data = vl_fill, aes(x = xnew, xend = xend, y = y, yend = y,
                                   color = violinwidth), show.legend = FALSE) +
  # Re-use geom_violin to plot the outline
  geom_violin(data = df_input, aes(x = as.integer(cut), y = carat, fill = cut),
              color = "white", alpha = 0, draw_quantiles = c(0.25, 0.5, 0.75),
              show.legend = FALSE) +
  scale_x_continuous(breaks = breaks, labels = labels) +
  scale_color_viridis_c() +
  labs(x = "Cut", y = "Carat")