[ggdesplot] fix spurious colour legend, named-palette fallback, and multi-facet

NEWS.md

@@ -1,5 +1,11 @@
 # desplot 1.11 ()
 
+* `ggdesplot()` no longer draws a spurious `no_color` legend when `text` or `num` is used without `col`. (P.Schmidt)
+
+* `ggdesplot()` now facets on every conditioning variable in a formula such as `yield ~ col*row | site + rep`. Previously only the first was used and the others were silently dropped, overplotting cells. (P.Schmidt)
+
+* `ggdesplot()` named `col.regions` and `col.text` now fall back to positional matching (as the warning states) when some factor levels are unnamed, instead of leaving cells uncolored. (P.Schmidt)
+
 * Switch to MIT license.
 
 * Documentation pages now created via Github Actions.

R/ggdesplot.R

@@ -270,7 +270,8 @@ ggdesplot <- function(data,
         warning("col.regions: Not all factor levels found in provided names. ",
                 "Missing: ", paste(missing_levels, collapse=", "),
                 ". Falling back to positional matching.")
-        col.regions <- rep(col.regions, length=fill.n)
+        # Strip names so scale_fill_manual() matches positionally, not by name.
+        col.regions <- rep(as.vector(col.regions), length=fill.n)
       } else {
         col.regions <- as.vector(matched_colors)
       }
@@ -359,6 +360,18 @@ ggdesplot <- function(data,
   fac2num <- function(x) as.numeric(levels(x))[x]
   if(is.factor(data[[x.string]])) data[[x.string]] <- fac2num(data[[x.string]])
   if(is.factor(data[[y.string]])) data[[y.string]] <- fac2num(data[[y.string]])
+
+  # Combine ALL conditioning variables into a single panel factor, so a formula
+  # like 'y ~ x*z | a + b' facets on every conditioning variable. Previously only
+  # ff$cond[1] was used, silently dropping the rest and overplotting cells.
+  if(length(ff$cond) > 0L){
+    panel.string <- ".panel"
+    data[[panel.string]] <- interaction(data[ff$cond], sep=" | ",
+                                        drop=TRUE, lex.order=TRUE)
+  } else {
+    panel.string <- NULL
+  }
+
   data <- .addLevels(data, x.string, y.string, panel.string)
 
   # Check for multiple values
@@ -414,7 +427,8 @@ ggdesplot <- function(data,
         warning("col.text: Not all factor levels found in provided names. ",
                 "Missing: ", paste(missing_levels, collapse=", "),
                 ". Falling back to positional matching.")
-        if(length(col.text) < col.n) col.text <- rep(col.text, length=col.n)
+        # Strip names so scale_color_manual() matches positionally, not by name.
+        col.text <- rep(as.vector(col.text), length=col.n)
       } else {
         col.text <- as.vector(matched_colors)
       }
@@ -514,9 +528,11 @@ ggdesplot <- function(data,
   if(has.text|has.num|has.col) # cell text
     #out = out + geom_text(aes_string(x.string, y.string, 
     out = out + geom_text(aes(x=.data[[x.string]], y=.data[[y.string]], 
-                              label=.data[["cell.text"]], color=.data[[col.string]]), 
-                          size=4*cex) + 
-    scale_color_manual(values=col.text)
+                              label=.data[["cell.text"]], color=.data[[col.string]]),
+                          size=4*cex) +
+    # Only show a color key when 'col' was actually supplied; otherwise the
+    # internal dummy 'no_color' factor would leak in as a spurious legend.
+    scale_color_manual(values=col.text, guide=if(has.col) "legend" else "none")
 
   if(has.dq) {
     # Data quality indicator

tests/testthat/test_ggdesplot_fixes.R

@@ -0,0 +1,46 @@
+# Regression tests for ggdesplot() bug fixes
+library(desplot)
+
+# 2 sites x 2 reps, 3x3 grid; response constant within a panel, differs across.
+twocond <- expand.grid(x = 1:3, row = 1:3,
+                       site = c("S1", "S2"), rep = c("R1", "R2"))
+twocond$site <- factor(twocond$site)
+twocond$rep  <- factor(twocond$rep)
+twocond$y    <- as.numeric(interaction(twocond$site, twocond$rep))
+
+# 4 fill levels but names only cover two -> triggers positional fallback
+partial <- data.frame(
+  col = rep(1:4, times = 4),
+  row = rep(1:4, each = 4),
+  rep = factor(paste0("R", rep(1:4, length.out = 16)))
+)
+
+test_that("ggdesplot does not add a spurious colour legend without 'col'", {
+  skip_if_not(utils::packageVersion("ggplot2") >= "3.5.0")
+  data(besag.met, package = "agridat")
+  p <- suppressWarnings(ggdesplot(besag.met, yield ~ col * row, text = gen))
+  # the dummy 'no_color' aesthetic must not produce a drawn colour guide
+  expect_null(ggplot2::get_guide_data(p, "colour"))
+})
+
+test_that("ggdesplot named col.regions fallback colours every level", {
+  p <- suppressWarnings(
+    ggdesplot(partial, rep ~ col * row, col.regions = c(R1 = "red", R2 = "blue")))
+  b <- ggplot2::ggplot_build(p)
+  # no tile should be left unfilled (grey NA) by the positional fallback
+  expect_false(any(is.na(b$data[[1]]$fill)))
+})
+
+test_that("ggdesplot facets on every conditioning variable", {
+  p <- suppressWarnings(ggdesplot(twocond, y ~ x * row | site + rep))
+  b <- ggplot2::ggplot_build(p)
+  expect_equal(length(unique(b$data[[1]]$PANEL)), 4L)
+  # each panel holds exactly its 9 cells (no overplotting from a dropped factor)
+  expect_true(all(table(b$data[[1]]$PANEL) == 9L))
+})
+
+test_that("ggdesplot single conditioning variable keeps its panel labels", {
+  data(besag.met, package = "agridat")
+  p <- suppressWarnings(ggdesplot(besag.met, yield ~ col * row | county))
+  expect_equal(levels(p$data$.panel), paste0("C", 1:6))
+})