R语言 如何使用ggplot在条形图上创建自定义图形标签

rdrgkggo  于 2023-03-20  发布在  其他
关注(0)|答案(1)|浏览(134)

我有以下数据和代码...

#generate example data
rG_activity <- c("0.230", "0.335", NA, "0.368", "0.368", "0.327", "0.091", "-0.230")
rG_activity_error_intervals <- c("(-0.075, 0.335)", "(0.239, 0.631)", NA, "(0.234, 0.602)", "(0.284, 0.752)", "(0.229, 0.726)", "(-0.259, 0.340)", "(-0.311, 0.252)")
rG_task_persistence <- c("-0.304", "-0.302", "-0.309", "-0.362", "-0.345", "-0.291", "-0.062", "-0.291")
rG_task_persistence_error_intervals <- c("(-0.242, -0.266)", "(-0.268, -0.236)","(-0.256, -0.263)", "(-0.679, -0.244)", "(-0.260, -0.231)", "(-0.396, -0.086)", "(-0.272, 0.247)", "(-0.207, -0.074)")
rE_activity <- c("0.005","-0.024", NA, "0.256", "-0.225", "-0.054", "-0.013", "0.058")
rE_activity_error_intervals <- c("(-0.255, 0.266)", "(0.243, -0.291)", NA,"(-0.021, 0.333)", "(-0.298, 0.048)", "(-0.248, 0.240)", "(-0.266, 0.240)", "(-0.225, 0.241)")
rE_task_persistence <- c("0.211", "-0.006", "-0.098", "0.093", "-0.002", "0.203", "0.047", "0.205")
rE_task_persistence_error_intervals <- c("(-0.046, 0.269)", "(0.257, -0.269)", "(-0.261, 0.064)", "(-0.065, 0.251)", "(-0.274, 0.270)", "(-0.065, 0.272)", "(-0.212, 0.206)", "(-0.071, 0.280)")
rG_emotionality <- c("0.230", "0.335", "-0.309", "0.368", "0.368", "0.327", "0.091", "-0.230")
rG_emotionality_error_intervals <- c("(-0.075, 0.335)", "(0.239, 0.631)", "(-0.256, -0.263)", "(0.234, 0.602)", "(0.284, 0.752)", "(0.229, 0.726)", "(-0.259, 0.340)", "(-0.311, 0.252)")
rE_emotionality <- c("0.005","-0.024", "-0.098", "0.256", "-0.225", "-0.054", "-0.013", "0.058")
rE_emotionality_error_intervals <- c("(-0.255, 0.266)", "(0.243, -0.291)", "(-0.261, 0.064)","(-0.021, 0.333)", "(-0.298, 0.048)", "(-0.248, 0.240)", "(-0.266, 0.240)", "(-0.225, 0.241)")
age <- c("slope", "intercept", "36", "30", "24", "18", "12", "6")
df <- 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, rG_emotionality, rG_emotionality_error_intervals, rE_emotionality, rE_emotionality_error_intervals)

#produce figure
library(data.table)
setDT(df)
df_tidy <- melt(df , measure.vars = list(values=c("rG_activity","rG_task_persistence","rE_activity","rE_task_persistence", "rG_emotionality", "rE_emotionality"),
                              intervals=c("rG_activity_error_intervals","rG_task_persistence_error_intervals","rE_activity_error_intervals","rE_task_persistence_error_intervals", "rG_emotionality_error_intervals","rE_emotionality_error_intervals")))
df_tidy[ , values:=as.numeric(values)]
df_tidy[ , c("lci", "uci") := tstrsplit(gsub("[()]","",intervals),split=",",type.convert = TRUE)]
df_tidy[ , condition := c("rG_activity", "rG_persistence", "rE_activity", "rE_persistence", "rG_emotionality", "rE_emotionality")[variable]]
df_tidy[ , c("what","type") := tstrsplit(condition,split="_")]

ggplot(df_tidy) + 
  aes(x=age, y=values, ymin=lci, ymax=uci,fill=what) + 
  geom_col(position = "dodge", color = "black", width = 0.7) + 
  geom_errorbar(position=position_dodge(width=0.7),width=0.25) + 
  facet_wrap(~type, ncol=1) + 
  scale_fill_grey(
    start = 0.475 ,
    end = 0.8,
    na.value = "red",
    aesthetics = "fill"
  ) +
  geom_text(size=2.75,aes(label=values,y=if_else(values > 0, pmax(uci, lci) + 0.1, pmin(uci, lci) - 0.1)),
            position=position_dodge(width=0.7)) +
  theme_classic() + 
  labs(y = "Correlation") +
  labs(x = "") +
  theme(legend.position = "bottom", legend.title=element_blank(), legend.margin=margin(0, 0, 0, 0)) + 
  scale_x_discrete(limits = c("6", "12", "18", "24", "30", "36", "slope", "intercept"),
                   labels = c("6"="Age 6", "12"="Age 12", "18"="Age 18", "24"="Age 24", "30"="Age 30", "36"="Age 36", "slope", "intercept")) + 
  geom_text(data = unique(df_tidy[is.na(values),],
            by = c("age", "type")), label = "N/A", y = 0, size = 2.5)

得出这个数字...

我想修改上面的代码,在我的时间点(6、12、18、24、30、36)下创建一个自定义轴/标签。理想情况下,我想生成如下所示的内容(见图的最底部):

我知道这可以很容易地在油漆/photoshop上完成,但它可能是可怕的,如果我能把它内置到我的代码。将感谢任何帮助如何做到这一点。

7gcisfzg

7gcisfzg1#

我们可以在coord_cartesian中关闭削波,并在底部刻面添加geom_linegeom_text

ggplot(df_tidy, aes(age, values)) + 
  geom_col(position = "dodge", color = "black", width = 0.7, aes(fill = what)) + 
  geom_errorbar(aes(ymin = lci, ymax = uci, group = what),
                position = position_dodge(width = 0.7), width = 0.25) + 
  geom_text(aes(label = values, group = what,
                y = if_else(values > 0, 
                            pmax(uci, lci) + 0.1, 
                            pmin(uci, lci) - 0.1)),
            position = position_dodge(width = 0.7), size = 2.75) +
  geom_text(data = unique(df_tidy[is.na(values),], by = c("age", "type")), 
            label = "N/A", y = 0, size = 2.5) +
  geom_line(data = data.frame(age = as.character(c(6, 6, 36, 36)),
                              values = c(-1.1, -1.2, -1.2, -1.1),
                              type = "persistence"), aes(group = 1)) +
  geom_text(data = data.frame(age = "18", values = -1.3, type = "persistence"),
            aes(label = "Age (months)"), hjust = 0) +
  scale_x_discrete(name = "", 
                   limits = c(6 * 1:6, "slope", "intercept"),
                   labels = c("6" = "Age 6", "12" = "Age 12", "18" = "Age 18", 
                              "24" = "Age 24", "30" = "Age 30",
                              "36" = "Age 36", "slope", "intercept")) + 
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  facet_wrap(~type, ncol = 1) + 
  coord_cartesian(ylim = c(-0.8, 0.9), clip = "off") +
  labs(y = "Correlation") +
  theme_classic() + 
  theme(legend.position = c(0.9, -0.05), 
        legend.direction = 'horizontal',
        legend.title = element_blank(), 
        legend.margin = margin(0, 0, 0, 0),
        strip.background = element_rect(linewidth = 0.5),
        plot.margin = margin(10, 10, 30, 10))

相关问题