R语言 修改代码以向条形图中添加两个新列

2ul0zpep  于 2023-03-15  发布在  其他
关注(0)|答案(2)|浏览(141)

我有以下数据框和条形图代码...

#create dataframe
Correlation_task_persistence <-  c("0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_task_persistence  <- c("57%", "56%", "53%", "29%", "51%", "45%")
Correlation_activity <- c(NA, "0.19", "0.08", "0.08", "0.03", "0.00")
Biv_A_activity <- c(NA, "80%", "45%", "70%", "10%", "50%")
Biv_E_activity <- c(NA, "20", "55%", "30%", "90%", "50%")
age <- c("36", "30", "24", "18", "12", "6")
df <- data.frame(Correlation_task_persistence, Biv_A_task_persistence,Biv_E_task_persistence, Correlation_activity, Biv_A_activity, Biv_E_activity, age )

#produce plot
df %>% 
  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.01 * sign(x), size = 3) +
  geom_text(aes(label = label), size = 3, 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$age))) +
  facet_wrap(~group)

由此得出这个条形图......

我想添加两个新列到这个条形图(“斜率”和“截距”)。以下(新)数据框包含“斜率”和“截距”的数据。我想调整下面的条形图代码...

#updated dataframe with data for new columns
Correlation_task_persistence <-  c("0.19", "0.19","0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("80%", "80%","43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_task_persistence  <- c("20%", "20%", "57%", "56%", "53%", "29%", "51%", "45%")
Correlation_activity <- c("0.19", "0.19", NA, "0.19", "0.08", "0.08", "0.03", "0.00")
Biv_A_activity <- c("80%", "80%", NA, "80%", "45%", "70%", "10%", "50%")
Biv_E_activity <- c("20%", "20%", NA, "20%", "55%", "30%", "90%", "50%")
age <- c("intercept", "slope", "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 )

#code to modify
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.01 * sign(x), size = 3) +
  geom_text(aes(label = label), size = 3, 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)

要生成这样的条形图(右侧追加两个新列):

rjee0c15

rjee0c151#

@Jon Spring的评论解释了你需要做些什么来解决你的问题,但是看看你的代码,你需要做一些修改来得到你想要的结果(可能需要一段时间来弄清楚)。
下面是一个“工作”示例,您可以在此基础上进行构建:

library(tidyverse)

#updated dataframe with data for new columns
Correlation_task_persistence <-  c("0.19", "0.19","0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("80%", "80%","43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_task_persistence  <- c("20%", "20%", "57%", "56%", "53%", "29%", "51%", "45%")
Correlation_activity <- c("0.19", "0.19", NA, "0.19", "0.08", "0.08", "0.03", "0.00")
Biv_A_activity <- c("80%", "80%", NA, "80%", "45%", "70%", "10%", "50%")
Biv_E_activity <- c("20%", "20%", NA, "20%", "55%", "30%", "90%", "50%")
age <- c("intercept", "slope", "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 )

#code to modify
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 = "(.*)_([^_]+)$") %>%
  group_by(age, group) %>%
  mutate(label = scales::percent(final_value / sum(final_value))) %>%
  ungroup() %>%
  mutate(age = factor(age,
                      levels = c("0", "6", "12", "18", "24", "30", "36", "intercept", "slope"),
                      ordered = TRUE)) %>%
  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.01 * sign(x), size = 3) +
  geom_text(aes(label = label), size = 3, position = position_stack(vjust = 0.5)) +
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  labs(y = "Correlation") +
  facet_wrap(~group)
#> Warning: There were 4 warnings in `mutate()`.
#> The first warning was:
#> ℹ In argument: `across(...)`.
#> Caused by warning in `if_else()`:
#> ! NAs introduced by coercion
#> ℹ Run `dplyr::last_dplyr_warnings()` to see the 3 remaining warnings.
#> Warning: Removed 2 rows containing non-finite values (`stat_summary()`).
#> Warning: Removed 2 rows containing missing values (`position_stack()`).
#> Removed 2 rows containing missing values (`position_stack()`).
#> Warning: Removed 4 rows containing missing values (`geom_text()`).

创建于2023年3月15日,使用reprex v2.0.2
你也有很多需要注意的警告。祝你好运!

yc0p9oo0

yc0p9oo02#

试试这个:

df2 <- 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.factor(age)) %>% # change to factor here
  tidyr::extract("name", c("var","group"), regex = "(.*)_([^_]+)$") %>%
  group_by(age, group) %>%
  mutate(label = scales::percent(final_value / sum(final_value)))

ggplot(data=df2,
       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.01 * sign(x), size = 3) +
  geom_text(aes(label = label), size = 3, position = position_stack(vjust = 0.5)) +
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  labs(y = "Correlation") +
  scale_x_discrete(breaks = c('12', '18', '24', '30', '36', '6', 'intercept', 'slope'),
                   labels = c('12', '18', '24', '30', '36', '6', 'intercept', 'slope')) + # changes to the x scale
  facet_wrap(~group)

相关问题