admin管理员组

文章数量:1290972

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

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

Share Improve this question edited Feb 13 at 18:24 M-- 29.2k10 gold badges69 silver badges106 bronze badges Recognized by R Language Collective asked Feb 13 at 15:40 Homer Jay SimpsonHomer Jay Simpson 1,2328 silver badges35 bronze badges 4
  • Is this just a duplicate of the question from 2 days ago? I don't think this is possible with just gglikert because it violates how ggplot2 facets are defined, but you can use tidytext. – Axeman Commented Feb 13 at 21:13
  • @Axeman here I ask for reordering-sorting the facet rows and facet cols.In the 2 days ago question I ask for sorting within facet rows and match the facet categories with the bar plot. But I didn't;t know the tidytext. Can you elaborate or probably provide your take on this? I would appreciate it. – Homer Jay Simpson Commented Feb 13 at 21:23
  • To clarify, you can do the reordering for each facet using tidytext as in the link, but you would likely still have to code your own ggplot, which you don't seem open to. – Axeman Commented Feb 13 at 21:40
  • @Axeman I am open. If it will look the same as gglikert but sorted the way I ask I totally fine. – Homer Jay Simpson Commented Feb 13 at 21:42
Add a comment  | 

2 Answers 2

Reset to default 3

You could simply add sort = "ascending" argument to the gglikert.

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

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

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

本文标签: rSort gglikert within facets rows the subplotsStack Overflow