R语言 如何在条形图上的值为0的情况下删除条形轮廓

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

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

library(tidyverse)

#generate 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(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") +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) + 
  facet_wrap(~group)

由此产生了这个情节...

如果你看那些值为0的条形图(例如,最左边的条形图),条形图的 Package 似乎有点轮廓。我该如何从值为0的列中选择性地删除那个小条形图呢?要生成这样的结果,那些讨厌的小线条就消失了。

weylhg0b

weylhg0b1#

一个选项是对于具有零值的条将linewidth设置为0,即

geom_col(aes(linewidth = final_value > 0), color = "black")

并通过设置linewidth

scale_linewidth_manual(values = c("TRUE" = .5, "FALSE" = 0), guide = "none")

在这里添加了guide="none"以删除图例。

library(tidyverse)

# 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)

7vux5j2d

7vux5j2d2#

您可以根据final_value的值设置geom_colcolor(即aes(color=final_value == 0)),如果为零,则设置为“白色”,否则设置为“黑色”(即scale_color_manual(values = c("black", "white")))。

library(tidyverse)

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(color=final_value == 0)) +
  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_color_manual(values = c("black", "white"), guide = "none) +
  labs(y = "Correlation") +
  labs(x = "") +
  theme(legend.position = "bottom",
        legend.title = element_blank()) + 
  facet_wrap(~group)

相关问题