在R图中的堆栈栏中添加信息列

Question

我想在堆栈栏区域的右侧添加一个信息栏（参见）。就像完全做结合了经常和偶尔。我想在 R 中执行此操作。

创建数据框

# Load required libraries
library(tidyverse)

# Create the data frame
data <- data.frame(
  event = c("Talking with family", "Donating good", "Posting on social media", "Give interview", "Working/Voluntering for a charity", "Speaking with journalist", "Participating in protest"),
  lk1 = c(23, 20, 21, 40, 36, 40, 23),
  lk2 = c(10, 36, 30, 12, 12, 12, 25),
  lk3 = c(36, 20, 37, 36, 40, 36, 40),
  lk4 = c(31, 24, 12, 12, 12, 12, 12),
  lk1_lk2 = c(33, 56, 51, 52, 48, 52, 48)
)

# Reshape the data for ggplot
data_long <- data %>%
  pivot_longer(cols = c(lk1:lk4), names_to = "likert", values_to = "value") %>%
  mutate(event = factor(event, levels = rev(unique(event))))

绘图

ggplot(data_long, aes(x = value, y = event, fill = likert)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = value), position = position_stack(vjust = 0.5), color = "white", size = 3) +
  geom_text(data = data_long %>% filter(likert == "lk1"), 
            aes(label = lk1_lk2, x = max(value) + 2, y = event),
            hjust = -50, color = "black", size = 3) +
  scale_x_continuous(labels = scales::percent_format(), expand = expand_scale(add = c(1, 10))) + # Adjusting x-axis limits
  labs(title = "Preference Distribution for Various Events",
       x = "Percentage",
       y = "Event") +
  theme_minimal() +
  theme(legend.position = "top") +
  geom_text(data = NULL, aes(x = Inf, y = Inf, label = "Do at All"),
            hjust = 1, vjust = 1, color = "black") +  # Add text at right-top corner
  scale_fill_discrete(labels = c("lk1" = "Often", "lk2" = "Occasionally", "lk3" = "Never", "lk4" = "Prefer not to say"))

Answer 1

一种方法是制作单独的图，然后使用牛图组合：

library(dplyr)
library(ggplot2)
library(cowplot)

p_main <- ggplot(data_long, aes(x = value, y = event, fill = likert)) +
  geom_col() +
  geom_text(aes(label = value), position = position_stack(vjust = 0.5), color = "white", size = 3) + 
  scale_x_continuous(labels = \(x) paste0(x, "%"), expand = expansion(add = c(1, 1))) + 
  labs(x = "Percentage", y = "Event") +
  theme_minimal() +
  theme(legend.position = "top") +
  scale_fill_discrete(labels = c("lk1" = "Often", "lk2" = "Occasionally", "lk3" = "Never", "lk4" = "Prefer not to say"))

p_do_at_all <- ggplot(
    distinct(data_long, event, lk1_lk2), 
    aes("", event)
  ) +
  geom_text(aes(label = lk1_lk2), size = 3) +
  theme_void()

# I would think you could use get_legend() here, 
# but it throws an error due to trying to get multiple components.
# as a workaround:
legend <- get_plot_component(p_main, "guide-box", return_all = TRUE)[[4]]

p_main <- p_main + scale_fill_discrete(guide = "none")

title <- ggdraw() +
  draw_label("Preference Distribution for Various Events")

lab_do_at_all <- ggdraw() +
  draw_label("Do at all", size = 10)

plot_grid(
  title, 
  plot_grid(legend, lab_do_at_all, rel_widths = c(8, 1)),
  plot_grid(p_main, p_do_at_all, align = "h", rel_widths = c(8, 1)),
  ncol = 1,
  rel_heights = c(3, 2, 30)
)