From 359f655c55bcbe73bd0a278ca525b99dd0e3774e Mon Sep 17 00:00:00 2001 From: Paul Schmidt Date: Fri, 19 Jun 2026 22:14:54 +0200 Subject: [PATCH] [ggdesplot] fix spurious colour legend, named-palette fallback, and multi-facet Three issues in ggdesplot() (the lattice desplot() is unaffected): - A dummy 'no_color' factor leaked in as a visible colour legend whenever 'text' or 'num' was used without 'col'. The colour key is now suppressed unless 'col' is supplied. - The named col.regions / col.text fallback kept vector names, so scale_*_manual() still matched by name and left unmatched levels uncolored. Names are stripped so the documented positional fallback actually applies. - A formula like 'y ~ x*z | a + b' only faceted on the first conditioning variable; the rest were silently dropped and cells overplotted. All conditioning variables are now combined into the panel factor. --- NEWS.md | 6 ++++ R/ggdesplot.R | 26 ++++++++++++--- tests/testthat/test_ggdesplot_fixes.R | 46 +++++++++++++++++++++++++++ 3 files changed, 73 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/test_ggdesplot_fixes.R diff --git a/NEWS.md b/NEWS.md index fbae9e7..7bf3e41 100644 --- a/NEWS.md +++ b/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. diff --git a/R/ggdesplot.R b/R/ggdesplot.R index 908ca20..bf468a1 100644 --- a/R/ggdesplot.R +++ b/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 diff --git a/tests/testthat/test_ggdesplot_fixes.R b/tests/testthat/test_ggdesplot_fixes.R new file mode 100644 index 0000000..5584aa1 --- /dev/null +++ b/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)) +})