Sort Likert levels based on combination of levels and horizontally matching the grouping facet rows with a bar plot in R

Question

I have the same simulated data as described here.

I want to sort all the sublikert plots in each facet based on the sum of "Strongly disagree" and "Disagree".

Additionally how can I combine those two plots:First the likert plot with the facet rows as the grouping variable and the corresponding bar count plot of the grouping variable to match horizontally (as you can see from the picture are not matching) with the likert plot ?

Therefore the sorting issues are two:

1. Sort the questions q1 to q6 inside each facet, based on the sum of strongly agree and agree

2. Sort the group1 categories based in a descending order from the biggest to the smallest based on count.

And also to match each each facet in the likert plot with the bar plot.

I think that tidytext reordering with facets might help but i don’t know how to implement it. Anyway, any ggplot2 alternative is welcome since ggstats is a wrapper of ggplot2.

Any help ?

library(ggstats)
library(dplyr)
library(ggplot2)
library(patchwork)
likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)
df <-
  tibble(
    grouping = sample(c(LETTERS[1:9]), 150, replace = TRUE),
    q1 = sample(likert_levels, 150, replace = TRUE),
    q2 = sample(likert_levels, 150, replace = TRUE, prob = 5:1),
    q3 = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    q4 = sample(likert_levels, 150, replace = TRUE, prob = 1:5),
    q5 = sample(c(likert_levels, NA), 150, replace = TRUE),
    q6 = sample(likert_levels, 150, replace = TRUE, prob = c(1, 0, 1, 1, 0))
  ) %>%
  mutate(across(-grouping, ~ factor(.x, levels = likert_levels)))
df


filter_df = df %>%
  dplyr::select(grouping) %>%
  dplyr::group_by(grouping) %>%
  dplyr::summarise(n = n()) %>%
  dplyr::filter(n >= 15)%>%
  dplyr::arrange(desc(n))
parameters = as.vector(filter_df[[1]])

v1 = gglikert(df, q1:q6, 
         facet_rows = vars(grouping)) +
  aes(y = reorder(factor(.question), ave(as.numeric(.answer), .question, FUN = \(x) {
    sum(x %in% 4:5) / length(x[!is.na(x)])
  }))) +
  labs(y = NULL) +
  theme(
    panel.border = element_rect(color = "gray", fill = NA),
    axis.text.x = element_blank(),
    legend.position = "bottom",
    strip.text = element_text(color = "black", face = "bold"),
    strip.placement = "outside"
  )+
  theme(strip.text.y = element_text(angle = 0))+
  facet_grid(rows = vars(grouping), labeller = labeller(grouping = label_wrap_gen(width = 5)))
v2 = filter_df %>%
  ggplot2::ggplot(aes(y = grouping, x = n)) +
  geom_bar(stat = "identity", fill = "lightgrey") +
  geom_text(aes(label = n), position = position_stack(vjust = 0.5)) +
  theme_light() +
  theme(
    panel.border = element_rect(color = "gray", fill = NA),
    axis.text.x = element_blank(),
    legend.position = "none"
  ) +
  labs(x = NULL, y = NULL)
v1+v2+
  plot_layout(widths = c(0.8, 0.2), guides = "collect") &
  theme(legend.position = "bottom")

Answer 1

Here is an option using the data_fun= argument of gglikert which allows to do some additional manipulations on the data provided by gglikert, i.e. we can overwrite the .question variable by the interaction of .question and grouping and reorder this variable as required for your final result. Note that this still requires to switch to facet_wrap, use scales="free_y" and fix the axis labels. Also note that this is not an option when using facet_grid which only allows to free the scales per row or column not per panel. Finally note that I slightly tweaked the code for the bar chart for a nicer alignment with the liker chart.

library(dplyr)
library(ggplot2)
library(patchwork)
library(ggstats)

# Seed used to create the data
set.seed(42)

data_fun <- function(.data) {
  .data |>
    mutate(
      .question = interaction(grouping, .question),
      .question = reorder(
        .question,
        ave(as.numeric(.answer), .question, FUN = \(x) {
          sum(x %in% 4:5) / length(x[!is.na(x)])
        }),
        decreasing = TRUE
      )
    )
}

v1 <- gglikert(df, q1:q6,
  facet_rows = vars(grouping),
  add_totals = TRUE,
  data_fun = data_fun
) +
  scale_y_discrete(
    labels = ~ gsub("^.*\\.", "", .x)
  ) +
  labs(y = NULL) +
  theme(
    panel.border = element_rect(color = "gray", fill = NA),
    axis.text.x = element_blank(),
    legend.position = "bottom",
    strip.text = element_text(color = "black", face = "bold"),
    strip.placement = "outside"
  ) +
  theme(strip.text.y = element_text(angle = 0)) +
  facet_wrap(
    facets = vars(grouping),
    labeller = labeller(grouping = label_wrap_gen(width = 5)),
    ncol = 1, scales = "free_y",
    strip.position = "right"
  )


v2 <- filter_df %>%
  ggplot2::ggplot(aes(y = grouping, x = n)) +
  geom_bar(stat = "identity", fill = "lightgrey") +
  geom_text(aes(label = n), position = position_stack(vjust = 0.5)) +
  scale_y_discrete(
    limits = rev, expand = c(0, 0)
  ) +
  theme_light() +
  theme(
    panel.border = element_rect(color = "gray", fill = NA),
    axis.text.x = element_blank(),
    legend.position = "none"
  ) +
  labs(x = NULL, y = NULL)

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