基于Base R创建渐变色堆叠条形图子图及图例位置调整问题

问题解决代码及说明 #

我帮你调整了代码，完全用Base R实现了你的需求，包括渐变堆叠条形、浅色上层、右侧中部公共图例，以下是完整方案：

# 准备数据
color <- c('W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl', 'W', 'Y', 'O', 'P', 'R', 'Br', 'Gr', 'Bl')
mass <- c(10, 14, 20, 15, 16, 13, 11, 15, 10, 14, 23, 18, 12, 22, 20, 13, 14, 17, 20, 22, 24, 17, 23, 18, 14, 15, 16, 19, 17, 15, 15, 21, 22, 18, 15, 21, 19, 23, 14, 18, 15, 23, 10, 16, 22, 10, 20, 18, 15, 12, 16, 13, 13, 15, 10, 14, 23, 18, 18, 22, 20, 13, 24, 19, 18, 24, 20, 22, 17, 19, 24, 21)
fir.mass <- c(3, 1, 4, 10, 8, 10, 3, 5, 2, 8, 7, 4, 7, 4, 10, 12, 8, 13, 16, 15, 17, 10, 18, 16, 7, 12, 13, 10, 9, 10, 11, 9, 10, 15, 14, 18, 15, 17, 7, 17, 11, 20, 5, 6, 11, 7, 13, 12, 14, 10, 8, 10, 7, 11, 5, 6, 9, 3, 17, 4, 10, 13, 18, 13, 16, 16, 15, 17, 11, 15, 20, 15)
name <- c('K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'K3', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'D1', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2', 'B2', 'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'D3', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'K1', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 'D2', 'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'B3', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'K2', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1', 'B1')
pet.data <- data.frame(color, name, mass, fir.mass)

# 指定宠物分类
kitty <- c('K1', 'K2', 'K3')
bunny <- c('B1', 'B2', 'B3')
doggy <- c('D1', 'D2', 'D3')

# 生成渐变色彩：下层（mass）从白到黑渐变，上层（fir.mass）对应浅色版本
dark_grad <- colorRampPalette(c('white', 'black'))(8)
# 自定义浅色生成函数：向白色靠拢提升亮度
lighten_color <- function(col, brightness = 0.3) {
  rgb_vals <- col2rgb(col)
  rgb_vals <- rgb_vals + (255 - rgb_vals) * brightness
  rgb(rgb_vals[1,], rgb_vals[2,], rgb_vals[3,], maxColorValue = 255)
}
light_grad <- sapply(dark_grad, lighten_color)

# 设置图形布局：3x3子图，右侧预留足够空间放图例
par(mfrow = c(3, 3), 
    mar = c(3, 3, 2, 0.5),  # 缩小子图右侧边距
    oma = c(1, 1, 1, 7),    # 右侧外边距留足图例空间
    mgp = c(2, 0.7, 0))

# 循环绘制每个子图
for (i in 1:nlevels(pet.data$name)) {
  pet_name <- levels(pet.data$name)[i]
  # 简化宠物类型判断
  pet_type <- if(pet_name %in% kitty) 'kitty' else if(pet_name %in% bunny) 'bunny' else 'doggy'
  
  # 提取当前宠物数据并整理为barplot所需矩阵
  current_data <- pet.data[pet.data$name == pet_name, ]
  plot_matrix <- rbind(current_data$mass, current_data$fir.mass)
  
  barplot(plot_matrix, 
          main = substitute(paste('Size of ', bold('lovely '), pet_type, ' (', pet_name, ')'), 
                           env = list(pet_type = pet_type, pet_name = pet_name)),
          xlab = 'Fur color', 
          ylab = 'Mass', 
          las = 1, 
          names.arg = c('White', 'Yellow', 'Orange', 'Pink', 'Red', 'Brown', 'Gray', 'Black'),
          col = c(dark_grad, light_grad))  # 下层深色渐变，上层对应浅色
  abline(h = 0)
}

# 添加右侧中部的公共图例
par(xpd = NA)  # 允许绘制到外边距区域
legend(x = par("usr")[2] + 4,  # 定位到所有子图右侧外部
       y = mean(par("usr")[3:4]),  # 垂直居中
       legend = c('Body', 'Fur'), 
       fill = c(dark_grad[4], light_grad[4]),  # 用中间渐变颜色做示例
       bty = 'n', 
       cex = 1.2)
par(xpd = FALSE)  # 恢复默认绘图区域限制

核心修改点说明 #

1. 色彩系统优化

   • 生成8个从白到黑的深色渐变组，对应每个x轴类别的底部条形
   • 通过自定义函数生成每个深色的浅色版本，确保堆叠部分比底部更浅
   • 直接将渐变色彩组传入barplot，实现每个x类别条形的渐变效果

2. 图例位置修复

   • 调整mar和oma参数，为右侧图例预留足够空间
   • 使用par(xpd = NA)允许图例绘制到子图外部的外边距区域
   • 通过par("usr")获取全局绘图坐标，精准定位到右侧中部

3. 代码可读性提升

   • 简化宠物类型判断逻辑，替换嵌套ifelse
   • 单独提取当前宠物数据，让循环内代码更清晰

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