数据准备
iris 的三个物种在数据里本来就是因子，但显式指定 levels 是个好习惯——否则组的顺序取决于字母序，换个数据集就变了。
library(ggplot2)
library(ggpubr)
library(biopalette)
iris_data <- iris |>
transform(
Species = factor(Species, levels = c("setosa", "versicolor", "virginica"))
)
# x 轴标签带上每组样本量 —— 读者判断"这个形状可不可信"要靠它
species_labels <- setNames(
paste0(levels(iris_data$Species), "\n(n=",
as.integer(table(iris_data$Species)), ")"),
levels(iris_data$Species)
)
walter_white2 <- get_palette("walter_white2", type = "qualitative")
species_colors <- setNames(
walter_white2[c(1, 2, 4)],
levels(iris_data$Species)
)
pairwise <- list(
c("setosa", "versicolor"),
c("versicolor", "virginica"),
c("setosa", "virginica")
)
y_max <- max(iris_data$Sepal.Length)
PAPER <- "#F4F3EE"
INK <- "#353531"
方法 A · geom_violin() 叠图层
三层各司其职：小提琴给形状、散点给原始观测、最后盖上的窄箱线给四分位和中位数。箱线放在散点之后，避免中央摘要被点遮住。
#| fig: layered
#| fig-width: 8
#| fig-height: 7
violin_plot <- ggplot(
iris_data,
aes(x = Species, y = Sepal.Length, fill = Species, color = Species)
) +
geom_violin(
trim = TRUE, # 轮廓停在实际最小值和最大值；尾部形状仍是密度估计
scale = "width", # 每组最宽处相同，宽度只用来比较形状
width = 0.88,
alpha = 0.46,
linewidth = 0.9
) +
geom_jitter(
# 种子绑在 position 上，而不是在外面写一句 set.seed()。抖动是**每次绘制时**
# 算的，不是建对象时算的 —— 同一个对象画两次，点就落在不同位置。下面那张
# 带统计标注的图用的正是这个对象，不绑种子的话两张图的散点会对不上。
position = position_jitter(width = 0.08, seed = 123), # 只水平抖，垂直抖会改数值
shape = 21,
color = INK,
size = 1.8,
stroke = 0.35,
alpha = 0.72
) +
geom_boxplot(
width = 0.11, # 压窄，当作小提琴内部的一根"骨架"
outlier.shape = NA, # 离群点已经由上面的散点完整呈现
fill = PAPER,
alpha = 0.92,
linewidth = 0.85
) +
scale_x_discrete(labels = species_labels) +
scale_y_continuous(
breaks = seq(4, 8, 0.5),
expand = expansion(mult = c(0.04, 0.08))
) +
scale_fill_manual(values = species_colors) +
scale_color_manual(values = species_colors) +
guides(fill = "none", color = "none") + # x 轴已经写了组名，图例是重复信息
labs(
title = "Sepal length by species",
subtitle = "Violin: density · box: quartiles · dots: observations",
x = NULL,
y = "Sepal length (cm)"
) +
theme_pubr(base_size = 13, legend = "none") +
theme(
plot.title = element_text(face = "bold", size = 17),
plot.subtitle = element_text(color = "#57564F", size = 10.5,
margin = margin(b = 10)),
axis.title.y = element_text(face = "bold", margin = margin(r = 10)),
plot.background = element_rect(fill = PAPER, colour = NA),
panel.background = element_rect(fill = PAPER, colour = NA)
)
violin_plot
