R语言 将条形图中的空条替换为NA

6pp0gazn  于 2023-03-20  发布在  其他
关注(0)|答案(2)|浏览(142)

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

#example data
Correlation_task_persistence <-  c("0.29", "0.29","0.24", "0.20", "0.24", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("80%", "80%","44%", "44%", "47%", "72%", "49%", "55%")
Biv_E_task_persistence  <- c("20%", "20%", "57%", "56%", "54%", "29%", "52%", "45%")
Correlation_activity <- c("0.29", "0.29", NA, "0.29", "0.08", "0.08", "0.07", "0.00")
Biv_A_activity <- c("80%", "80%", NA, "80%", "45%", "70%", "20%", "50%")
Biv_E_activity <- c("20%", "20%", NA, "20%", "55%", "40%", "90%", "50%")
age <- c("intercept", "slope", "36", "30", "24", "18", "12", "6")
Correlation_emotionality <-  c("0.19", "0.19","0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_emotionality <- c("80%", "80%","43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_emotionality  <- c("20%", "20%", "57%", "56%", "53%", "29%", "51%", "45%")
df.new <- data.frame(Correlation_task_persistence, Biv_A_task_persistence,Biv_E_task_persistence, Correlation_activity, Biv_A_activity, Biv_E_activity, Correlation_emotionality, Biv_A_emotionality, Biv_E_emotionality, age)

#produce the bar plot
df.new %>%
  mutate(across(
    Correlation_task_persistence:Biv_E_emotionality,
    ~ 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,
      Correlation_emotionality
    ),
    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(aes(linewidth = final_value > 0), color = "black") +
  theme_classic() +
  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") +
  scale_linewidth_manual(values = c("TRUE" = .5, "FALSE" = 0), guide = "none") +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(
    legend.position = "bottom",
    legend.title = element_blank()
  ) +
  facet_wrap(~group)

产生了这样的情节:

36岁时没有“活动”和“情绪”的栏,因为这些数据是N/A。我想修改上面的代码,用N/A替换空白,生成如下所示的数字:

会很感激你的帮助。

k4emjkb1

k4emjkb11#

您可以基于NA值创建一个 Dataframe ,并使用ifelse标签将其Map到geom_text,如下所示:

library(tidyverse)
df_NA = df.new %>%
  mutate(across(
    Correlation_task_persistence:Biv_E_emotionality,
    ~ 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,
                          Correlation_emotionality
    ),
    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
  )) %>%
  group_by(group, age, var) %>%
  summarise(any_NA = any(is.na(Correlation))) %>%
  filter(any_NA == TRUE)

#produce the bar plot
df.new %>%
  mutate(across(
    Correlation_task_persistence:Biv_E_emotionality,
    ~ 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,
                          Correlation_emotionality
    ),
    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(aes(linewidth = final_value > 0), color = "black") +
  theme_classic() +
  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") +
  scale_linewidth_manual(values = c("TRUE" = .5, "FALSE" = 0), guide = "none") +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(
    legend.position = "bottom",
    legend.title = element_blank()
  ) +
  facet_wrap(~group) +
  geom_text(df_NA, mapping = aes(x = age, y = 0, group = age, fill = var, label = ifelse(any_NA == TRUE, 'N/A', '')))

创建于2023年3月17日,使用reprex v2.0.2

ehxuflar

ehxuflar2#

在我们开始之前,我使用的ggplot2(v3.3.5)没有scale_linewidth_manual(),所以我做了一点调整,但应该很重要。
试试这个:

library(dplyr)
library(tidyr)
library(ggplot2)

#example data
Correlation_task_persistence <-  c("0.29", "0.29","0.24", "0.20", "0.24", "0.04", "0.00", "0.04")
Biv_A_task_persistence <- c("80%", "80%","44%", "44%", "47%", "72%", "49%", "55%")
Biv_E_task_persistence  <- c("20%", "20%", "57%", "56%", "54%", "29%", "52%", "45%")
Correlation_activity <- c("0.29", "0.29", NA, "0.29", "0.08", "0.08", "0.07", "0.00")
Biv_A_activity <- c("80%", "80%", NA, "80%", "45%", "70%", "20%", "50%")
Biv_E_activity <- c("20%", "20%", NA, "20%", "55%", "40%", "90%", "50%")
age <- c("intercept", "slope", "36", "30", "24", "18", "12", "6")
Correlation_emotionality <-  c("0.19", "0.19","0.34", "0.10", "0.13", "0.04", "0.00", "0.04")
Biv_A_emotionality <- c("80%", "80%","43%", "44%", "47%", "71%", "49%", "55%")
Biv_E_emotionality  <- c("20%", "20%", "57%", "56%", "53%", "29%", "51%", "45%")
df.new <- data.frame(
  Correlation_task_persistence, 
  Biv_A_task_persistence,
  Biv_E_task_persistence, 
  Correlation_activity, 
  Biv_A_activity, 
  Biv_E_activity, 
  Correlation_emotionality, 
  Biv_A_emotionality, 
  Biv_E_emotionality, 
  age
)

#produce the bar plot

df.new %>%
  mutate(
    across(
      Correlation_task_persistence:Biv_E_emotionality,
      ~ 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,
      Correlation_emotionality
    ),
    final_value = Correlation * value,
    name = gsub("_task", "", name)
  ) %>%
  tidyr::extract("name", c("var", "group"), regex = "(.*)_([^_]+)$") %>%
  group_by(age, group) %>%
  mutate(
    label = dplyr::if_else(
      is.na(final_value),
      "NA",
      scales::percent(final_value / sum(final_value))
    ),
    dummy_final_value = dplyr::if_else(
      is.na(final_value), 0, 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(aes(linewidth = final_value > 0), color = "black") +
  theme_classic() +
  geom_text(
    aes(label = Correlation, group = age),
    stat = "summary", 
    fun = function(x) {sum(x) + 0.01 * sign(x)}, 
    size = 3
  ) +
  geom_text(
    aes(y = dummy_final_value, label = label), 
    size = 3, position = position_stack(vjust = 0.5)
  ) +
  scale_fill_grey(start = 0.475, end = 0.8, na.value = "red") +
  scale_discrete_manual(
    aesthetics = "linewidth", values = c("TRUE" = .5, "FALSE" = 0), guide = "none"
  ) +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(
    legend.position = "bottom",
    legend.title = element_blank()
  ) +
  facet_wrap(~group)

技巧是你可以在ggplot2中给不同的层分配不同的aes()。我为geom_text()层添加了一个dummy_final_value作为y轴Map。还稍微修改了.data$label以显示NA作为字符向量。

相关问题