R语言多面板绘图：显示完整旋转X轴标签并减少空白

问题描述 #

我参考了Stack Overflow上《Avoid wasting space when placing multiple aligned plots onto one page》的方案，设置了如下par参数：

par(mfrow = c(5, 2),     # 5行2列布局
    oma = c(2, 2, 0, 0), # 外侧底部和左侧留2行文本空间
    mar = c(1,6,2,1),    # 刻度处留1行文本空间，用于分隔子图
    mgp = c(2, 1, 0),    # 轴标签距离轴2行，刻度标签距离轴1行
    xpd = NA)            # 允许内容延伸到外侧边距（及以外）

生成的多面板绘图效果接近预期，但底部子图的旋转X轴标签被截断。我需要让标签完整显示且保持旋转状态。尝试在绘制最后2个子图前执行par(mar = c(1,6,2,1)+1)，但这会改变绘图尺寸，而非单纯显示标签。

可使用以下示例数据测试：

set.seed(42)
catA <- factor(c("m100", "m500", "m1000", "m2000", "m3000", "m5000"))
catB <- factor(20:28)
samples <- 100
rsample <- function(v) v[ceiling(runif(samples, max=length(v)))]
Tab <- data.frame(catA = rsample(catA),
                  catB = rsample(catB),
                  valA = rnorm(samples, 150, 8),
                  valB = pmin(1,pmax(0,rnorm(samples, 0.5, 0.3))))
op <- par(mfrow = c(2,2),
          oma = c(5,4,0,0) + 0.1,
          mar = c(0,0,1,1) + 0.1)
for (i in 0:3) {
  x <- Tab[[1 + i %% 2]]
  plot(x, Tab[[3 + i %/% 2]], axes = FALSE)
  axis(side = 1,
       at=1:nlevels(x),
       labels = if (i %/% 2 == 1) levels(x) else FALSE)
  axis(side = 2, labels = (i %% 2 == 0))
  box(which = "plot", bty = "l")
}
title(xlab = "Some Categories",
      ylab = "Some Values",
      outer = TRUE, line = 3)
par(op)

解决方案 #

方法1：为底部子图单独调整底部边距 #

核心思路是仅给底部子图增加底部边距，保持其他边距和绘图区域尺寸一致，避免整体布局变形：

set.seed(42)
catA <- factor(c("m100", "m500", "m1000", "m2000", "m3000", "m5000"))
catB <- factor(20:28)
samples <- 100
rsample <- function(v) v[ceiling(runif(samples, max=length(v)))]
Tab <- data.frame(catA = rsample(catA),
                  catB = rsample(catB),
                  valA = rnorm(samples, 150, 8),
                  valB = pmin(1,pmax(0,rnorm(samples, 0.5, 0.3))))

op <- par(mfrow = c(2,2),
          oma = c(2,4,0,0) + 0.1, # 减少外侧底部边距，由子图自身留出空间
          mar = c(0,0,1,1) + 0.1)

for (i in 0:3) {
  x <- Tab[[1 + i %% 2]]
  # 仅底部子图调整底部边距
  if (i %/% 2 == 1) {
    par(mar = c(3, 0, 1, 1) + 0.1) 
  } else {
    par(mar = c(0, 0, 1, 1) + 0.1)
  }
  plot(x, Tab[[3 + i %/% 2]], axes = FALSE)
  axis(side = 1,
       at=1:nlevels(x),
       labels = if (i %/% 2 == 1) levels(x) else FALSE,
       las = 2) # 旋转标签90度
  axis(side = 2, labels = (i %% 2 == 0))
  box(which = "plot", bty = "l")
}
title(xlab = "Some Categories",
      ylab = "Some Values",
      outer = TRUE, line = 1) # 适配新边距调整外侧标题位置
par(op)

方法2：用mtext手动添加旋转标签 #

如果不想调整子图边距，可通过mtext将标签绘制到外侧边距区域，避免截断：

set.seed(42)
catA <- factor(c("m100", "m500", "m1000", "m2000", "m3000", "m5000"))
catB <- factor(20:28)
samples <- 100
rsample <- function(v) v[ceiling(runif(samples, max=length(v)))]
Tab <- data.frame(catA = rsample(catA),
                  catB = rsample(catB),
                  valA = rnorm(samples, 150, 8),
                  valB = pmin(1,pmax(0,rnorm(samples, 0.5, 0.3))))

op <- par(mfrow = c(2,2),
          oma = c(4,4,0,0) + 0.1, # 为手动标签预留外侧底部空间
          mar = c(0,0,1,1) + 0.1)

for (i in 0:3) {
  x <- Tab[[1 + i %% 2]]
  plot(x, Tab[[3 + i %/% 2]], axes = FALSE)
  # 仅绘制刻度，用mtext添加旋转标签
  if (i %/% 2 == 1) {
    axis(side = 1, at=1:nlevels(x), labels = FALSE)
    mtext(levels(x), side = 1, at=1:nlevels(x), las=2, line=1.5, cex=0.8)
  } else {
    axis(side = 1, at=1:nlevels(x), labels = FALSE)
  }
  axis(side = 2, labels = (i %% 2 == 0))
  box(which = "plot", bty = "l")
}
title(xlab = "Some Categories",
      ylab = "Some Values",
      outer = TRUE, line = 2)
par(op)

方法3：结合mgp优化标签位置 #

通过mgp让刻度标签更靠近轴，配合最小化的底部边距，在不浪费空间的前提下显示完整标签：

set.seed(42)
catA <- factor(c("m100", "m500", "m1000", "m2000", "m3000", "m5000"))
catB <- factor(20:28)
samples <- 100
rsample <- function(v) v[ceiling(runif(samples, max=length(v)))]
Tab <- data.frame(catA = rsample(catA),
                  catB = rsample(catB),
                  valA = rnorm(samples, 150, 8),
                  valB = pmin(1,pmax(0,rnorm(samples, 0.5, 0.3))))

op <- par(mfrow = c(2,2),
          oma = c(2,4,0,0) + 0.1,
          mar = c(2,0,1,1) + 0.1, # 仅留2行底部边距
          mgp = c(1.5, 0.5, 0)) # 让刻度标签更贴近轴

for (i in 0:3) {
  x <- Tab[[1 + i %% 2]]
  plot(x, Tab[[3 + i %/% 2]], axes = FALSE)
  axis(side = 1,
       at=1:nlevels(x),
       labels = if (i %/% 2 == 1) levels(x) else FALSE,
       las=2) # 旋转标签
  axis(side = 2, labels = (i %% 2 == 0))
  box(which = "plot", bty = "l")
}
title(xlab = "Some Categories",
      ylab = "Some Values",
      outer = TRUE, line = 1)
par(op)

内容的提问来源于stack exchange，提问作者vermicellion