多X轴标签聚类柱状图的簇间间距调整问题
2026-7-25
问题描述
绘制聚类柱状图时遇到以下问题：
无法调整两个簇之间的间距，希望保持簇内条形紧密相邻的同时，增大簇间间距。尝试了position_dodge()等方案，但图表外观没有变化。是否是因为使用了双层X轴（分面）导致的？
数据
results <- structure(list(tdcs = c("active", "active", "active", "active", "active", "active", "sham", "sham", "sham", "sham", "sham", "sham" ), type = structure(c(2L, 2L, 3L, 3L, 1L, 1L, 2L, 2L, 3L, 3L, 1L, 1L), .Label = c("Comprehension", "Trained Words", "Untrained Words" ), class = "factor"), chgacc = c(0.693669355, 0.512145161, 0.189221837, 0.19727383, 0.488085538, 0.080855379, 0.365701923, 0.331008065, -0.405006036, -0.210909879, -0.135833333, 0.006145503), grouping = c("Active: 1 Month Post", "Active: 3 Months Post", "Active: 1 Month Post", "Active: 3 Months Post", "Active: 1 Month Post", "Active: 3 Months Post", "Sham: 1 Month Post", "Sham: 3 Months Post", "Sham: 1 Month Post", "Sham: 3 Months Post", "Sham: 1 Month Post", "Sham: 3 Months Post"), time = c("1 Month Post", "3 Months Post", "1 Month Post", "3 Months Post", "1 Month Post", "3 Months Post", "1 Month Post", "3 Months Post", "1 Month Post", "3 Months Post", "1 Month Post", "3 Months Post")), row.names = c(NA, -12L), spec = structure(list(cols = list(tdcs = structure(list(), class = c("collector_character", "collector")), type = structure(list(), class = c("collector_character", "collector")), chgacc = structure(list(), class = c("collector_double", "collector")), grouping = structure(list(), class = c("collector_character", "collector")), time = structure(list(), class = c("collector_character", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), skip = 1L), class = "col_spec"), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"))
绘图代码
library(tidyverse) library(cowplot) results$type <- as.factor(results$type) colorpicks <- c("darkslategray", "azure3","blue3", "cyan") plot <- results %>% dplyr::filter(type == "Trained Words") %>% ggplot(aes(x = time, y = chgacc, fill = grouping)) + theme_minimal_hgrid()+ geom_col(position = position_dodge(0.9), width = 1) + facet_wrap(~tdcs, strip.position = "bottom", scales = "free_x" ) + scale_fill_manual(values = colorpicks, labels = c('Active - 1 Month Post','Active - 3 Months Post', 'Sham - 1 Month Post', 'Sham - 3 Months Post'))+ theme(panel.spacing = unit(0,"lines"), strip.background = element_blank(), strip.placement = "outside")+ scale_y_continuous(labels = scales::label_percent(accuracy = 1),limits = (c(-.2,.7))) + labs(x = "Stimulation Type", y = "Mean Accuracy \nChange from Baseline", fill = 'Stimulation Type & \nTime Point')+ theme(plot.title = element_text(size = 16), strip.text = element_text(size = 16), axis.text = element_text(size = 12), axis.text.x = element_text(angle = 90, vjust = 0, hjust = 1), axis.title.y = element_blank(), axis.title.x = element_blank(), legend.text=element_text(size=11)) plot
解决方案
你的判断没错，问题确实出在facet_wrap的分面设置上——当前每个分面的X轴独立（scales="free_x"），无法通过position_dodge直接调整跨分面的簇间距。下面提供两种可行方案：
方案1：取消分面，手动控制簇间距
通过合并分组变量、设置位置偏移来模拟双层X轴，直接控制簇间间距：
library(tidyverse) library(cowplot) results$type <- as.factor(results$type) colorpicks <- c("darkslategray", "azure3","blue3", "cyan") # 预处理数据：合并分组并设置位置偏移 plot_data <- results %>% dplyr::filter(type == "Trained Words") %>% mutate(x_group = fct_inorder(paste(tdcs, time, sep = "_"))) %>% # 给Sham组整体右移，拉开和Active组的间距 mutate(x_pos = case_when( tdcs == "active" ~ as.integer(x_group), tdcs == "sham" ~ as.integer(x_group) + 1 )) plot <- plot_data %>% ggplot(aes(x = x_pos, y = chgacc, fill = grouping)) + theme_minimal_hgrid()+ # 簇内条形紧密，调整width控制条形宽度 geom_col(position = position_dodge(width = 0.8), width = 0.7) + # 手动设置上层X轴（刺激类型）的刻度和标签 scale_x_continuous( breaks = c(1.5, 3.5), labels = c("Active", "Sham"), expand = c(0.1, 0.1) ) + # 添加下层X轴（时间点）的标签 annotate("text", x = c(1,2,3,4), y = -0.22, label = rep(c("1 Month Post", "3 Months Post"), 2), size = 4) + scale_fill_manual(values = colorpicks, labels = c('Active - 1 Month Post','Active - 3 Months Post', 'Sham - 1 Month Post', 'Sham - 3 Months Post'))+ # 扩大Y轴范围，容纳下层标签 scale_y_continuous(labels = scales::label_percent(accuracy = 1),limits = (c(-.25,.7))) + labs(x = "Stimulation Type", y = "Mean Accuracy \nChange from Baseline", fill = 'Stimulation Type & \nTime Point')+ theme(plot.title = element_text(size = 16), axis.text = element_text(size = 12), axis.text.x = element_text(size = 16), axis.title.y = element_blank(), axis.title.x = element_blank(), legend.text=element_text(size=11)) plot
方案2：保留分面，调整分面间距
修改分面参数，取消X轴自由缩放，通过panel.spacing增大簇间（分面间）间距：
library(tidyverse) library(cowplot) results$type <- as.factor(results$type) colorpicks <- c("darkslategray", "azure3","blue3", "cyan") plot <- results %>% dplyr::filter(type == "Trained Words") %>% ggplot(aes(x = time, y = chgacc, fill = grouping)) + theme_minimal_hgrid()+ geom_col(position = position_dodge(0.9), width = 0.8) + # 取消X轴自由缩放，保证分面对齐 facet_wrap(~tdcs, strip.position = "bottom", scales = "fixed" ) + scale_fill_manual(values = colorpicks, labels = c('Active - 1 Month Post','Active - 3 Months Post', 'Sham - 1 Month Post', 'Sham - 3 Months Post'))+ # 增大分面间距，即簇间间距 theme(panel.spacing = unit(2,"lines"), strip.background = element_blank(), strip.placement = "outside")+ scale_y_continuous(labels = scales::label_percent(accuracy = 1),limits = (c(-.2,.7))) + labs(x = "Stimulation Type", y = "Mean Accuracy \nChange from Baseline", fill = 'Stimulation Type & \nTime Point')+ theme(plot.title = element_text(size = 16), strip.text = element_text(size = 16), axis.text = element_text(size = 12), axis.text.x = element_text(angle = 90, vjust = 0, hjust = 1), axis.title.y = element_blank(), axis.title.x = element_blank(), legend.text=element_text(size=11)) plot
内容的提问来源于stack exchange，提问作者novicecoder
相关产品推荐
相关产品推荐
