R语言 如何调整我的条形图代码,以适应这两个新的列?

pcww981p  于 2023-03-15  发布在  其他
关注(0)|答案(1)|浏览(123)

我有以下代码....

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)

vltsax25

vltsax251#

经过与OP长时间的讨论,我们发现使用x轴的因子水平需要一些处理,如以下代码所示。

#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(ifelse(is.na(as.numeric(age)==T),as.factor(age),age))) # here's the adjustment
         # 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)
  )

然后在图代码中调整scale_x_discrete调用,以创建正确的标签。

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 = c("age 6", "age 12", "age 18", "age 24", "age 30", "age 36", "slope", "intercept"))+
  scale_y_continuous(expand = c(0, .3)) +
  facet_wrap(~type, ncol = 1) +
  theme(legend.position = "bottom") +
  labs(x = NULL, y = "Correlation", fill = NULL)

相关问题