使用ggplot2根据R中的条形图对likert图进行排序

Question

我在 R 中有一个名为 df 的数据框：

# Load necessary libraries
library(tibble)
library(tidyverse)
library(ggplot2)
library(ggpubr)
library(ggstats)

# Define categories and Likert levels
var_levels <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")

likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

# Set seed for reproducibility
set.seed(42)

# Create the dataframe with three Likert response columns
df <- tibble(
  var = sample(var_levels, 50, replace = TRUE),  # Random values from A to Q
  val1 = sample(likert_levels, 50, replace = TRUE) # Random values from Likert levels
  
)

# View the first few rows of the dataframe
print(df)

就像明智的here在提供的解决方案中一样，我希望条形图显示在左侧并以降序方式排序，并基于条形图的排序相应地对位于likert图中的相同类别进行排序现在。假设 p1 是右侧显示的李克特图，左侧是条形图。我怎样才能在 R 中做到这一点？

dat <- df |>
  mutate(
    across(-var, ~ factor(.x, likert_levels))
  ) |>
  pivot_longer(-var, names_to = "group") |>
  count(var, value, group) |>
  complete(var, value, group, fill = list(n = 0)) |>
  mutate(
    prop = n / sum(n),
    prop_lower = sum(prop[value %in% c("Strongly disagree", "Disagree")]),
    prop_higher = sum(prop[value %in% c("Strongly agree", "Agree")]),
    .by = c(var, group)
  ) |>
  arrange(group, prop_lower) |>
  mutate(
    y_sort = paste(var, group, sep = "."),
    y_sort = fct_inorder(y_sort)
  )

top10 <- dat |>
  distinct(group, var, prop_lower) |>
  slice_max(prop_lower, n = 10, by = group)

dat <- dat |>
  semi_join(top10)
#> Joining with `by = join_by(var, group, prop_lower)`

dat_tot <- dat |>
  distinct(group, var, y_sort, prop_lower, prop_higher) |>
  pivot_longer(-c(group, var, y_sort),
               names_to = c(".value", "name"),
               names_sep = "_"
  ) |>
  mutate(
    hjust_tot = ifelse(name == "lower", 1, 0),
    x_tot = ifelse(name == "lower", -1, 1)
  )

条形图

bar_plot <- dat%>%
  select(var,n)%>%
  group_by(var)%>%
  summarise(count = sum(n))%>%
  ggplot(., aes(y = var, x = count)) +
  geom_bar(stat = "identity", fill = "lightgrey")+labs(x="Response Count",y="")+
  geom_text(aes(label = count),position = position_stack(vjust = .5)) +
  theme_bw()+
  theme(
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    axis.text.x = element_blank(),   # Remove x-axis text
    axis.ticks.x = element_blank()    # Remove x-axis ticks
  )

李克特图

likert_plot <- ggplot(dat, aes(y = y_sort, x = prop, fill = value)) +
  geom_col(position = position_likert(reverse = FALSE)) +
  geom_text(
    aes(
      label = label_percent_abs(hide_below = .05, accuracy = 1)(prop),
      color = after_scale(hex_bw(.data$fill))
    ),
    position = position_likert(vjust = 0.5, reverse = FALSE),
    size = 3.5
  ) +
  geom_label(
    aes(
      x = x_tot,
      label = label_percent_abs(accuracy = 1)(prop),
      hjust = hjust_tot,
      fill = NULL
    ),
    data = dat_tot,
    size = 3.5,
    color = "black",
    fontface = "bold",
    label.size = 0,
    show.legend = FALSE
  ) +
  scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
  scale_x_continuous(
    labels = label_percent_abs(),
    expand = c(0, .15)
  ) +
  scale_fill_brewer(palette = "BrBG") +
  facet_wrap(~group,
             scales = "free_y", ncol = 1,
             strip.position = "right"
  ) +
  theme_light() +
  theme(
    legend.position = "bottom",
    panel.grid.major.y = element_blank()
  ) +
  labs(x = NULL, y = NULL, fill = NULL)

library(patchwork)
bar_plot + likert_plot + plot_layout(guides = "collect") & theme(legend.position="bottom")

Answer 1

这个问题涉及很多内容，我可能误解了；这是你想要的结果吗？

library(tidyverse)
library(ggpubr)
library(ggstats)
#> Warning: package 'ggstats' was built under R version 4.3.2
library(patchwork)

# Define categories and Likert levels
var_levels <- c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")

likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)

# Set seed for reproducibility
set.seed(42)

# Create the dataframe with three Likert response columns
df <- tibble(
  var = sample(var_levels, 50, replace = TRUE),  # Random values from A to Q
  val1 = sample(likert_levels, 50, replace = TRUE) # Random values from Likert levels
  
)

# View the first few rows of the dataframe
print(df)
#> # A tibble: 50 × 2
#>    var   val1                      
#>    <chr> <chr>                     
#>  1 Q     Strongly agree            
#>  2 E     Agree                     
#>  3 A     Agree                     
#>  4 J     Strongly disagree         
#>  5 D     Neither agree nor disagree
#>  6 Q     Neither agree nor disagree
#>  7 O     Strongly agree            
#>  8 G     Strongly agree            
#>  9 D     Agree                     
#> 10 E     Strongly agree            
#> # ℹ 40 more rows

dat <- df |>
  mutate(
    across(-var, ~ factor(.x, likert_levels))
  ) |>
  pivot_longer(-var, names_to = "group") |>
  count(var, value, group) |>
  complete(var, value, group, fill = list(n = 0)) |>
  mutate(
    prop = n / sum(n),
    prop_lower = sum(prop[value %in% c("Strongly disagree", "Disagree")]),
    prop_higher = sum(prop[value %in% c("Strongly agree", "Agree")]),
    .by = c(var, group)
  ) |>
  arrange(group, prop_lower) |>
  mutate(
    y_sort = paste(var, group, sep = "."),
    y_sort = fct_inorder(y_sort)
  )

top10 <- dat |>
  distinct(group, var, prop_lower) |>
  slice_max(prop_lower, n = 10, by = group)

dat <- dat |>
  semi_join(top10)
#> Joining with `by = join_by(var, group, prop_lower)`
#> Joining with `by = join_by(var, group, prop_lower)`

dat_tot <- dat |>
  distinct(group, var, y_sort, prop_lower, prop_higher) |>
  pivot_longer(-c(group, var, y_sort),
               names_to = c(".value", "name"),
               names_sep = "_"
  ) |>
  mutate(
    hjust_tot = ifelse(name == "lower", 1, 0),
    x_tot = ifelse(name == "lower", -1, 1)
  )

bar_plot <- dat %>%
  select(var, n) %>%
  group_by(var) %>%
  summarise(count = sum(n)) %>%
  full_join(dat) %>%
  select(y_sort, count) %>%
  unique() %>%
  ggplot(., aes(y = y_sort, x = count)) +
  geom_bar(stat = "identity", fill = "lightgrey") +
  labs(x="Response Count",y="") +
  geom_text(aes(label = count),
            position = position_stack(vjust = .5)) +
  theme_bw() +
  theme(
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    axis.text.x = element_blank(),   # Remove x-axis text
    axis.ticks.x = element_blank()    # Remove x-axis ticks
  )
#> Joining with `by = join_by(var)`
bar_plot

likert_plot <- dat %>%
  ggplot(aes(y = y_sort, x = prop,
             fill = value)) +
  geom_col(position = position_likert(reverse = FALSE)) +
  geom_text(
    aes(
      label = label_percent_abs(hide_below = .05, accuracy = 1)(prop),
      color = after_scale(hex_bw(.data$fill))
    ),
    position = position_likert(vjust = 0.5, reverse = FALSE),
    size = 3.5
  ) +
  geom_label(
    aes(
      x = x_tot,
      label = label_percent_abs(accuracy = 1)(prop),
      hjust = hjust_tot,
      fill = NULL
    ),
    data = dat_tot,
    size = 3.5,
    color = "black",
    fontface = "bold",
    label.size = 0,
    show.legend = FALSE
  ) +
  scale_y_discrete(labels = \(x) gsub("\\..*$", "", x)) +
  scale_x_continuous(
    labels = label_percent_abs(),
    expand = c(0, .15)
  ) +
  scale_fill_brewer(palette = "BrBG") +
  facet_wrap(~group,
             scales = "free_y", ncol = 1,
             strip.position = "right"
  ) +
  theme_light() +
  theme(
    legend.position = "bottom",
    panel.grid.major.y = element_blank()
  ) +
  labs(x = NULL, y = NULL, fill = NULL)

likert_plot

bar_plot + likert_plot + plot_layout(guides = "collect") &
  theme(legend.position="bottom")

^{创建于 2024-12-09，使用 reprex v2.1.0}