R语言 修复条形图的顺序并在条形图顶部(和条形图内)显示值

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

我有下面的数据和代码,产生一个条形图。

#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 pot
suppressWarnings(
  df.new %>% 
    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"))) %>% 
    mutate(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 = "(.*)_([^_]+)$") %>% 
 ggplot(aes(x = age, y = final_value, fill = var)) +
  geom_col() +
   scale_fill_grey(
  start = 0.475,
  end = 0.8,
  na.value = "red",
  aesthetics = "fill"
  ) +
  labs(x="Age (months)", y= "Correlation") +
  facet_wrap(~group)
)

我想修改我的代码,对条形图进行三处更改:
1.按6岁排在12岁之前的顺序排列年龄。因此,小节的顺序应该是6、12、18、24、30、36,而不是12、18、24、30、36、6。
1.在每个条形图的顶部显示相关性(例如,6岁时用黑色显示)。
1.在条内显示Biv_A和Biv_E值(例如,6岁时用黑色显示)。
会很感激任何帮助如何做到这一点。

x7yiwoj4

x7yiwoj41#

我认为这就是你想要的,虽然它看起来有点混乱与所有这些文本标签...

df.new %>% 
  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"))) %>% 
  mutate(Correlation = if_else(grepl("task", name),
                               Correlation_task_persistence, 
                               Correlation_activity),
         final_value = Correlation * value,
         name = gsub("_task", "", name),
         age = as.numeric(age)) %>%
  tidyr::extract("name", c("var","group"), regex = "(.*)_([^_]+)$") %>%
  group_by(age, group) %>%
  mutate(label = scales::percent(final_value / sum(final_value))) %>%
  ggplot(aes(x = age, y = final_value, fill = var)) +
  geom_col() +
  geom_text(aes(label = Correlation, group = age), 
            stat = 'summary', fun = function(x) sum(x) + 0.05 * sign(x)) +
  geom_text(aes(label = label), position = position_stack(vjust = 0.5)) +
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  labs(y = "Correlation") +
  scale_x_continuous(breaks = as.numeric(unique(df.new$age))) +
  facet_wrap(~group)

相关问题