Sort likert plot based on the bar plot in R using ggplot2

i have a data frame in R called 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)

like wise here in the solution provided i want the bar plot to be presented at the left and to be sorted in a descending way and based on that sorting onof the bar plot to be sorted accordingly the same categories in likert plot at the right now. Say if p1 is the likert plot to be presented at the right and the bar plot at the left. How can i do it in 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

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

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

Solution

There's a lot going on in this question and I may have misunderstood; is this your intended outcome?

library(tidyverse)
library(ggpubr)
library(ggstats)
library(patchwork)
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)`

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

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)

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

Or with different widths:

bar_plot + likert_plot + plot_layout(guides = "collect", widths = c(0.2, 0.8)) &
  theme(legend.position="bottom")

^{Created on 2024-12-09 with reprex v2.1.0}