调整条形图年龄排序并在条形内外添加数值标注

针对你提出的三处调整需求，以下是具体实现方案及修改后的完整代码：

调整说明 #

• 调整年龄顺序：将age列转换为有序因子，指定自定义顺序c("6", "12", "18", "24", "30", "36")，让ggplot按该顺序渲染x轴
• 条形顶部显示相关系数：用geom_text定位到每个堆叠条形的顶部，显示对应分组的相关系数值
• 条形内部显示Biv数值：用geom_text结合position_stack(vjust = 0.5)，在每个堆叠条的中心位置显示原始百分比数值

修改后的完整代码 #

# create data frame for bar plot
Correlation_task_persistence <- c("0.45", "0.40", "-0.46", "-0.24", "0.06", "0.16")
Biv_A_task_persistence <- c("63%", "66%", "67%", "71%", "69%", "55%")
Biv_E_task_persistence  <- c("37%", "34%", "33%", "29%", "31%", "45%")
Correlation_activity <- c("0.40", "0.33", "-0.59", "-0.10", "0.06", "0.10")
Biv_A_activity <- c("55%", "40%", "65%", "70%", "97%", "40%")
Biv_E_activity <- c("45%", "60%", "35%", "30%", "3%", "60%")  # 修正原数据格式问题，补全%
age <- c("36", "30", "24", "18", "12", "6")
df.new <- data.frame(Correlation_task_persistence, Biv_A_task_persistence,Biv_E_task_persistence, 
                     Correlation_activity, Biv_A_activity, Biv_E_activity, age )

# produce bar plot
suppressWarnings(
  df.new %>% 
    # 保留原始百分比文本，用于后续显示
    mutate(across(starts_with("Biv"), ~.x, .names = "original_{.col}")) %>%
    # 数值转换处理
    mutate(across(Correlation_task_persistence:Biv_E_activity, 
                  ~if_else(as.numeric(gsub("%", "", .x)) > 1,
                           as.numeric(gsub("%", "", .x, fixed = TRUE))/100, 
                           as.numeric(.x)))) %>% 
    pivot_longer(-c(age, contains("Correlation"), contains("original"))) %>% 
    # 匹配对应原始百分比文本
    mutate(original_value = case_when(
      name == "Biv_A_task_persistence" ~ original_Biv_A_task_persistence,
      name == "Biv_E_task_persistence" ~ original_Biv_E_task_persistence,
      name == "Biv_A_activity" ~ original_Biv_A_activity,
      name == "Biv_E_activity" ~ original_Biv_E_activity
    ),
    Correlation = if_else(grepl("task", name),
                         Correlation_task_persistence, Correlation_activity),
    final_value = Correlation * value,
    name = gsub("_task", "", name)) %>% 
    tidyr::extract("name", c("var","group"), regex = "(.*)_([^_]+)$") %>% 
    # 设置年龄的有序因子，强制x轴顺序
    mutate(age = factor(age, levels = c("6", "12", "18", "24", "30", "36"), ordered = TRUE)) %>%
    ggplot(aes(x = age, y = final_value, fill = var)) +
    geom_col() +
    # 条形内部显示原始百分比
    geom_text(aes(label = original_value), 
              position = position_stack(vjust = 0.5), color = "black", size = 3) +
    # 条形顶部显示相关系数，根据正负调整位置避免遮挡
    geom_text(data = . %>% distinct(age, group, Correlation),
              aes(y = ifelse(Correlation > 0, 
                            final_value_sum + 0.02, 
                            final_value_sum - 0.02), 
                  label = Correlation, fill = NULL),
              stat = "summary", fun = sum, color = "black", size = 3.5) +
    scale_fill_grey(
      start = 0.475,
      end = 0.8,
      na.value = "red",
      aesthetics = "fill"
    ) +
    labs(x="Age (months)", y= "Correlation") +
    facet_wrap(~group)
)

额外说明 #

1. 修正了原数据中Biv_E_activity列的"60"格式问题，补全为"60%"，避免数值转换错误
2. 通过factor(age, levels = ...)强制指定x轴年龄顺序，确保按6→12→18→24→30→36排列
3. 用position_stack(vjust = 0.5)让内部文本居中显示在堆叠条中
4. 顶部相关系数通过stat="summary", fun=sum计算每个age-group的总条形高度，再根据正负值调整文本位置（避免被条形遮挡）

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