如何调整R语言柱状图代码以适配slope与intercept新列

问题说明 #

原有基于tidyverse的柱状图代码仅处理数值型年龄数据，新增的df.new数据框在age列加入了intercept和slope两个非数值类别，导致原代码生成因子水平时出错，同时x轴标签会错误地给这两个类别加上"age"前缀，需要调整代码适配新数据。

修改后的完整代码 #

library(tidyverse)

# 包含slope和intercept的数据集
rG_activity <- c("-0.409", "-0.409", NA, "0.268", "0.268", "0.227", "0.092", "-0.220")
rG_activity_error_intervals <- c("(-0.556, -0.263)", "(-0.556, -0.263)", NA, "(0.222, 0.602)", "(0.282, 0.752)", "(0.229, 0.726)", "(-0.259, 0.220)", "(-0.222, 0.252)")
rG_task_persistence <- c("-0.409", "-0.409", "-0.209", "-0.262", "-0.225", "-0.292", "-0.062", "-0.292")
rG_task_persistence_error_intervals <- c("(-0.556, -0.263)", "(-0.556, -0.263)", "(-0.556, -0.262)", "(-0.679, -0.222)", "(-0.560, -0.222)", "(-0.296, -0.086)", "(-0.272, 0.227)", "(-0.507, -0.072)")
rE_activity <- c("-0.098", "-0.098", NA, "0.256", "-0.225", "-0.052", "-0.022", "0.058")
rE_activity_error_intervals <- c("(-0.261, 0.064)", "(-0.261, 0.064)", NA,"(-0.022, 0.222)", "(-0.298, 0.028)", "(-0.228, 0.220)", "(-0.266, 0.220)", "(-0.225, 0.222)")
rE_task_persistence <- c("-0.098", "-0.098", "-0.098", "0.092", "-0.002", "0.202", "0.027", "0.205")
rE_task_persistence_error_intervals <- c("(-0.261, 0.064)", "(-0.261, 0.064)", "(-0.262, 0.062)", "(-0.065, 0.252)", "(-0.272, 0.270)", "(-0.065, 0.272)", "(-0.222, 0.206)", "(-0.072, 0.280)")
age <- c("intercept", "slope", "36","30", "24", "18", "12", "6")
df.new <- data.frame(age, rG_activity, rG_activity_error_intervals, rG_task_persistence, rG_task_persistence_error_intervals, rE_activity, rE_activity_error_intervals, rE_task_persistence, rE_task_persistence_error_intervals)

# 整理数据并绘图
df_tidy <- df.new |>
  rename_with(~ paste0(.x, "_value"), !c(age, ends_with("intervals"))) |>
  pivot_longer(-age,
               names_to = c("what", "type", ".value"),
               names_pattern = "^(.*)_(activity|task_persistence)_(value|error_intervals)$") |>
  separate_wider_regex(error_intervals,
                       patterns = c("\\(", lower = ".*?", ",", upper = ".*?", "\\)")) |>
  mutate(across(c(value, lower, upper), as.numeric),
         # 手动指定因子水平：先放intercept、slope，剩余年龄按数值降序排列
         age = factor(age, levels = c("intercept", "slope", sort(unique(as.numeric(age[!age %in% c("intercept", "slope")])), decreasing = TRUE))))

df_tidy$what <- factor(df_tidy$what, levels = c("rG", "rE"))

df_tidy <- df_tidy |>
  mutate(
    ci_upper = pmax(upper, lower, na.rm = TRUE),
    ci_lower = pmin(upper, lower, na.rm = TRUE),
    y_label = if_else(value > 0, ci_upper, ci_lower) + .1 * if_else(value > 0, 1, -1),
    vjust = if_else(value > 0, 0, 1)
  )

ggplot(df_tidy, aes(age, value, fill = what)) +
  geom_col(position = "dodge") +
  geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper), position = position_dodge(width = .9), width = .25, na.rm = TRUE) +
  geom_text(size = 2.75,
            aes(
              label = round(value, 3),
              y = y_label,
              vjust = vjust
            ),
            position = position_dodge(width = .9),
            na.rm = TRUE) +
  scale_fill_grey(
    start = 0.475,
    end = 0.8,
    na.value = "red",
    aesthetics = "fill"
  ) +
  # 自定义x轴标签：仅给年龄值添加"age"前缀
  scale_x_discrete(labels = function(x) {
    ifelse(x %in% c("intercept", "slope"), x, paste("age", x))
  }) +
  scale_y_continuous(expand = c(0, .3)) +
  facet_wrap(~type, ncol = 1) +
  theme(legend.position = "bottom") +
  labs(x = NULL, y = "Correlation", fill = NULL)

关键修改点 #

• 因子水平调整：不再直接对所有age值转数值排序，手动指定intercept、slope为前两个水平，剩余年龄值按数值降序排列，保证显示顺序符合需求
• x轴标签修正：通过自定义标签函数，仅给数值型年龄值添加"age"前缀，避免给intercept和slope错误添加前缀
• NA值处理：在pmax/pmin和绘图函数中加入na.rm = TRUE，避免NA值导致的绘图错误
• 数值标签优化：将value标签保留三位小数，提升可读性

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