我有以下代码....
library(tidyverse)
#create example data
rG_activity <- c(NA, "0.268", "0.268", "0.227", "0.092", "-0.220")
rG_activity_error_intervals <- c(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.209", "-0.262", "-0.225", "-0.292", "-0.062", "-0.292")
rG_task_persistence_error_intervals <- c("(-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(NA, "0.256", "-0.225", "-0.052", "-0.022", "0.058")
rE_activity_error_intervals <- c(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.092", "-0.002", "0.202", "0.027", "0.205")
rE_task_persistence_error_intervals <- c("(-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("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)
#produce bar plot
df_tidy <- df |>
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),
age = factor(age, levels = sort(unique(as.numeric(age))))
)
df_tidy$what <- factor(df_tidy$what, levels = c("rG", "rE"))
df_tidy <- df_tidy |>
mutate(
ci_upper = pmax(upper, lower),
ci_lower = pmin(upper, lower),
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 = lower, ymax = upper), position = position_dodge(width = .9), width = .25) +
geom_text(size = 2.75,
aes(
label = value,
y = y_label,
vjust = vjust,
),
position = position_dodge(width = .9)
) +
scale_fill_grey(
start = 0.475,
end = 0.8,
na.value = "red",
aesthetics = "fill"
) +
scale_x_discrete(labels = ~ 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)
得出这个数字...
我想在上图中添加斜率和截距条形图。下面的新数据框包含了这些数据。
#df with the slope and intercept data
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)
由于 Dataframe 的格式,斜率和截距数据存储在与年龄列中的“斜率”和“截距”名称对应的行中(然而,创建一些复杂与我的代码上面用来生成第一个条形图)。我想调整我的代码(下图)才能使用这个新的df产生下图(现在包括斜率和截距数据,正如你在右边看到的)。如有任何帮助,将不胜感激。
#code to modify
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),
age = factor(age, levels = sort(unique(as.numeric(age))))
)
df_tidy$what <- factor(df_tidy$what, levels = c("rG", "rE"))
df_tidy <- df_tidy |>
mutate(
ci_upper = pmax(upper, lower),
ci_lower = pmin(upper, lower),
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 = lower, ymax = upper), position = position_dodge(width = .9), width = .25) +
geom_text(size = 2.75,
aes(
label = value,
y = y_label,
vjust = vjust,
),
position = position_dodge(width = .9)
) +
scale_fill_grey(
start = 0.475,
end = 0.8,
na.value = "red",
aesthetics = "fill"
) +
scale_x_discrete(labels = ~ 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)
1条答案
按热度按时间vltsax251#
经过与OP长时间的讨论,我们发现使用x轴的因子水平需要一些处理,如以下代码所示。
然后在图代码中调整scale_x_discrete调用,以创建正确的标签。