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