rggplot2likert

Sort gglikert within facets rows the subplots


I have the same simulated data as shown in the GitHub page of the library, regarding the facet rows and cols (included in the reproducible example below).

But I want to sort each subplot based on the sum of strongly agree and agree. How can I achieve this in R using gglikert?

library(ggstats)
library(dplyr)
library(ggplot2)
likert_levels <- c(
  "Strongly disagree",
  "Disagree",
  "Neither agree nor disagree",
  "Agree",
  "Strongly agree"
)
set.seed(42)
df <-
  tibble(
    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(everything(), ~ factor(.x, levels = likert_levels)))

df_group <- df
df_group$group1 <- sample(c("A", "B"), 150, replace = TRUE)
df_group$group2 <- sample(c("a", "b", "c"), 150, replace = TRUE)
gglikert(df_group,
  q1:q6,
  facet_cols = vars(group1),
  labels_size = 3
)

gglikert(df_group,
  q3:q6,
  facet_cols = vars(group1),
  facet_rows = vars(group2),
  labels_size = 3
) +
  scale_x_continuous(
    labels = label_percent_abs(),
    expand = expansion(0, .2)
  )


Solution

  • As already explained by @M-- there is no way to achieve this using just gglikert. And with facet_grid I don't see any option to achieve your desired result without patchwork (or ...).

    Hence, the easy approach would be to create each facet panel as a separate gglikert plot and combine them using patchwork. As drawback of this approach is that in general we end up with different x scales:

    library(tidyverse)
    library(ggstats)
    library(patchwork)
    
    df_split <- df_group |>
      split(~ group1 + group2)
    
    df_split |>
      map2(seq_along(df_split), \(x, y) {
        facet_layer <- if (y == 1) {
          facet_wrap(
            ~group1,
            scales = "free_y"
          )
        } else if (y == 2) {
          facet_grid(
            group2 ~ group1,
            scales = "free_y"
          )
        } else if (y %% 2 == 0) {
          facet_wrap(
            ~group2,
            strip.position = "right",
            scales = "free_y"
          )
        }
    
        gglikert(x,
          q1:q6,
          labels_size = 3,
          sort = "descending"
        ) +
          facet_layer
      }) |>
      wrap_plots(
        ncol = 2, guides = "collect"
      ) &
      theme(legend.position = "bottom")
    

    enter image description here

    The more elaborate approach would be to use ggplot2 to build the likert plot from scratch where I build on my answer on one of your previous questions but adds patchwork and allows to collect the axes too :

    dat <- df_group |>
      mutate(
        across(-c(group1, group2), ~ factor(.x, likert_levels))
      ) |>
      pivot_longer(-c(group1, group2), names_to = "var") |>
      filter(!is.na(value)) |>
      count(var, value, group1, group2) |>
      complete(var, value, group1, group2, 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, group1, group2)
      ) |>
      arrange(group1, group2, prop_higher) |>
      mutate(
        y_sort = paste(var, group1, group2, sep = "."),
        y_sort = fct_inorder(y_sort)
      )
    
    dat_tot <- dat |>
      distinct(group1, group2, var, y_sort, prop_lower, prop_higher) |>
      pivot_longer(-c(group1, group2, var, y_sort),
        names_to = c(".value", "name"),
        names_sep = "_"
      ) |>
      mutate(
        hjust_tot = ifelse(name == "lower", .5, .5),
        x_tot = ifelse(name == "lower", -1, 1)
      )
    
    dat |>
      split(~ group1 + group2) |>
      imap(\(x, y) {
        facet_layer <- if (y == "A.a") {
          facet_wrap(
            ~group1,
            scales = "free_y"
          )
        } else if (y == "B.a") {
          facet_grid(
            group2 ~ group1,
            scales = "free_y"
          )
        } else if (grepl("^B", y)) {
          facet_wrap(
            ~group2,
            strip.position = "right",
            scales = "free_y"
          )
        }
    
        dat_tot <- dat_tot |>
          filter(interaction(group1, group2) == y)
    
        ggplot(x, 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 = 8 / .pt
          ) +
          geom_label(
            aes(
              x = x_tot,
              label = label_percent_abs(accuracy = 1)(prop),
              hjust = hjust_tot,
              fill = NULL
            ),
            data = dat_tot,
            size =  8 / .pt,
            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),
            limits = c(-1, 1)
          ) +
          scale_fill_brewer(palette = "BrBG") +
          facet_layer +
          theme_light() +
          theme(
            legend.position = "bottom",
            panel.grid.major.y = element_blank()
          ) +
          labs(x = NULL, y = NULL, fill = NULL)
      }) |>
      patchwork::wrap_plots(
        ncol = 2, guides = "collect"
      ) +
      patchwork::plot_layout(axes = "collect_x") &
      theme(legend.position = "bottom")
    

    enter image description here