From ec75f37401916e2d7d5d22ea49a860dbc192f1ae Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 10:12:05 +0200 Subject: [PATCH 01/10] move all method setup to `setup_params()` --- R/stat-smooth.R | 47 +++++++++++++++++++++++------------------------ 1 file changed, 23 insertions(+), 24 deletions(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 864e229edf..942100a82f 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -95,36 +95,52 @@ StatSmooth <- ggproto("StatSmooth", Stat, setup_params = function(data, params) { params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE) msg <- character() - if (is.null(params$method) || identical(params$method, "auto")) { + method <- params$method + if (is.null(method) || identical(method, "auto")) { # Use loess for small datasets, gam with a cubic regression basis for # larger. Based on size of the _largest_ group to avoid bad memory # behaviour of loess max_group <- max(table(interaction(data$group, data$PANEL, drop = TRUE))) if (max_group < 1000) { - params$method <- "loess" + method <- "loess" } else { - params$method <- "gam" + method <- "gam" } - msg <- c(msg, paste0("method = '", params$method, "'")) + msg <- c(msg, paste0("method = '", method, "'")) } if (is.null(params$formula)) { - if (identical(params$method, "gam")) { + if (identical(method, "gam")) { params$formula <- y ~ s(x, bs = "cs") } else { params$formula <- y ~ x } msg <- c(msg, paste0("formula = '", deparse(params$formula), "'")) } - if (identical(params$method, "gam")) { - params$method <- gam_method() + + # Special case span because it's the most commonly used model argument + if (identical(method, "loess")) { + params$method.args$span <- params$span %||% 0.75 + } + + if (is.character(method)) { + if (identical(method, "gam")) { + method <- gam_method() + } else { + method <- match.fun(method) + } + } + # If gam and gam's method is not specified by the user then use REML + if (identical(method, gam_method())) { + params$method.args$method <- params$method.args$method %||% "REML" } if (length(msg) > 0) { cli::cli_inform("{.fn geom_smooth} using {msg}") } + params$method <- method params }, @@ -159,23 +175,6 @@ StatSmooth <- ggproto("StatSmooth", Stat, } } - # Special case span because it's the most commonly used model argument - if (identical(method, "loess")) { - method.args$span <- span - } - - if (is.character(method)) { - if (identical(method, "gam")) { - method <- gam_method() - } else { - method <- match.fun(method) - } - } - # If gam and gam's method is not specified by the user then use REML - if (identical(method, gam_method()) && is.null(method.args$method)) { - method.args$method <- "REML" - } - prediction <- try_fetch( { model <- inject(method( From 5824b1df9e300d246e8adeae37a2d462770f199f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 12:41:23 +0200 Subject: [PATCH 02/10] fallback to `method = "lm"` in absence of {mgcv} --- R/stat-smooth.R | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 942100a82f..f491da1066 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -111,7 +111,7 @@ StatSmooth <- ggproto("StatSmooth", Stat, } if (is.null(params$formula)) { - if (identical(method, "gam")) { + if (identical(method, "gam") && is_installed("mgcv")) { params$formula <- y ~ s(x, bs = "cs") } else { params$formula <- y ~ x @@ -133,7 +133,15 @@ StatSmooth <- ggproto("StatSmooth", Stat, } # If gam and gam's method is not specified by the user then use REML if (identical(method, gam_method())) { - params$method.args$method <- params$method.args$method %||% "REML" + if (identical(method, stats::lm)) { + cli::cli_warn(c( + "The {.pkg mgcv} package must be installed to use \\ + {.code method = \"gam\"}.", + "Falling back to {.code method = \"lm\"}." + )) + } else { + params$method.args$method <- params$method.args$method %||% "REML" + } } if (length(msg) > 0) { @@ -204,4 +212,10 @@ StatSmooth <- ggproto("StatSmooth", Stat, ) # This function exists to silence an undeclared import warning -gam_method <- function() mgcv::gam +gam_method <- function() { + if (is_installed("mgcv")) { + mgcv::gam + } else { + stats::lm + } +} From 88f065434696c3f4eb5c604f586505b45ff2b433 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 12:54:06 +0200 Subject: [PATCH 03/10] adjust tests --- tests/testthat/test-geom-smooth.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index 5f8282c176..a4093fa0ac 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -57,6 +57,8 @@ test_that("default smoothing methods for small and large data sets work", { y = x^2 + 0.5 * rnorm(1001) ) + skip_if_not_installed("mgcv") + m <- mgcv::gam(y ~ s(x, bs = "cs"), data = df, method = "REML") range <- range(df$x, na.rm = TRUE) xseq <- seq(range[1], range[2], length.out = 80) @@ -96,6 +98,18 @@ test_that("geom_smooth() works when one group fails", { expect_gte(nrow(ld), 2) }) +test_that("a warning is thrown when `method = 'gam'` and {mgcv} is absent", { + p <- ggplot(mpg, aes(displ, hwy)) + + geom_smooth(method = "gam", formula = y ~ x) + + with_mocked_bindings( + expect_warning( + ggplot_build(p), regexp = "package must be installed" + ), + is_installed = function(...) FALSE + ) +}) + # Visual tests ------------------------------------------------------------ test_that("geom_smooth() works with alternative stats", { From 80743c963727bb6c7759c34e616f9e228910b068 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 12:54:25 +0200 Subject: [PATCH 04/10] move {mgcv} from Imports to Suggests --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index dcaf992c7f..5686de5fc4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,7 +40,6 @@ Imports: isoband, lifecycle (> 1.0.1), MASS, - mgcv, rlang (>= 1.1.0), scales (>= 1.3.0), stats, @@ -56,6 +55,7 @@ Suggests: knitr, mapproj, maps, + mgcv, multcomp, munsell, nlme, From 978129cee6c3dd007d9b4ccc8e4a953a1186a0dc Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 12:55:29 +0200 Subject: [PATCH 05/10] add news bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 7e8594b4da..84f879dbcc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Moved {mgcv} from Imports to Suggests (@teunbrand, #5986) * All position scales now use the same definition of `x` and `y` aesthetics. This lets uncommon aesthetics like `xintercept` expand scales as usual. (#3342, #4966, @teunbrand) From dd3b5949f394f6e6f89dd63138c44f9aab665620 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 9 Jul 2024 16:26:05 +0200 Subject: [PATCH 06/10] Revert "fallback to `method = "lm"` in absence of {mgcv}" This reverts commit 5824b1df9e300d246e8adeae37a2d462770f199f. --- R/stat-smooth.R | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index f491da1066..942100a82f 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -111,7 +111,7 @@ StatSmooth <- ggproto("StatSmooth", Stat, } if (is.null(params$formula)) { - if (identical(method, "gam") && is_installed("mgcv")) { + if (identical(method, "gam")) { params$formula <- y ~ s(x, bs = "cs") } else { params$formula <- y ~ x @@ -133,15 +133,7 @@ StatSmooth <- ggproto("StatSmooth", Stat, } # If gam and gam's method is not specified by the user then use REML if (identical(method, gam_method())) { - if (identical(method, stats::lm)) { - cli::cli_warn(c( - "The {.pkg mgcv} package must be installed to use \\ - {.code method = \"gam\"}.", - "Falling back to {.code method = \"lm\"}." - )) - } else { - params$method.args$method <- params$method.args$method %||% "REML" - } + params$method.args$method <- params$method.args$method %||% "REML" } if (length(msg) > 0) { @@ -212,10 +204,4 @@ StatSmooth <- ggproto("StatSmooth", Stat, ) # This function exists to silence an undeclared import warning -gam_method <- function() { - if (is_installed("mgcv")) { - mgcv::gam - } else { - stats::lm - } -} +gam_method <- function() mgcv::gam From f0c5590216a35eaff918dcb9cb889133e49d7bc9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 11 Jul 2024 11:08:42 +0200 Subject: [PATCH 07/10] homebrew an install prompt --- R/utilities.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/R/utilities.R b/R/utilities.R index 1a9181be69..1f9faa68c7 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -818,3 +818,32 @@ as_unordered_factor <- function(x) { class(x) <- setdiff(class(x), "ordered") x } + +# TODO: Replace me if rlang/#1730 gets implemented +# Similar to `rlang::check_installed()` but returns boolean and misses +# features such as versions, comparisons and using {pak}. +prompt_install <- function(pkg, reason = NULL) { + if (length(pkg) < 1 || is_installed(pkg)) { + return(TRUE) + } + if (!interactive()) { + return(FALSE) + } + + pkg <- pkg[!vapply(pkg, is_installed, logical(1))] + + message <- "The {.pkg {pkg}} package{?s} {?is/are} required" + if (is.null(reason)) { + message <- paste0(message, ".") + } else { + message <- paste0(message, " ", reason) + } + question <- "Would you like to install {cli::qty(pkg)}{?it/them}?" + + cli::cli_bullets(c("!" = message, "i" = question)) + if (utils::menu(c("Yes", "No")) != 1) { + return(FALSE) + } + utils::install.packages(pkg) + is_installed(pkg) +} From afa61f7560dc39d99012298ae364f613e82fc78c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 11 Jul 2024 11:19:35 +0200 Subject: [PATCH 08/10] change fallback --- R/stat-smooth.R | 10 ++++++++++ tests/testthat/test-geom-smooth.R | 6 +++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 942100a82f..86ab67e4f5 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -110,6 +110,16 @@ StatSmooth <- ggproto("StatSmooth", Stat, msg <- c(msg, paste0("method = '", method, "'")) } + if (identical(method, "gam") && + !prompt_install("mgcv", "for using {.code method = \"gam\"}")) { + cli::cli_inform(c( + "The {.arg method} was set to {.val gam}, but {.pkg mgcv} is not installed.", + "!" = "Falling back to {.code method = \"lm\"}.", + i = "Change the {.arg method} argument to silence this message." + )) + method <- "lm" + } + if (is.null(params$formula)) { if (identical(method, "gam")) { params$formula <- y ~ s(x, bs = "cs") diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index a4093fa0ac..42c82108c7 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.R @@ -98,13 +98,13 @@ test_that("geom_smooth() works when one group fails", { expect_gte(nrow(ld), 2) }) -test_that("a warning is thrown when `method = 'gam'` and {mgcv} is absent", { +test_that("a fallback message is thrown when `method = 'gam'` and {mgcv} is absent", { p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth(method = "gam", formula = y ~ x) with_mocked_bindings( - expect_warning( - ggplot_build(p), regexp = "package must be installed" + expect_message( + ggplot_build(p), regexp = "Falling back to `method = \"lm\"`" ), is_installed = function(...) FALSE ) From daf23fac8f36392d5f9757284933ca3eac08ad0c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 11 Jul 2024 13:15:39 +0200 Subject: [PATCH 09/10] fix `gam_method()` in absence of mgcv --- R/stat-smooth.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 86ab67e4f5..776ff89481 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -214,4 +214,10 @@ StatSmooth <- ggproto("StatSmooth", Stat, ) # This function exists to silence an undeclared import warning -gam_method <- function() mgcv::gam +gam_method <- function() { + if (is_installed("mgcv")) { + mgcv::gam + } else { + NA + } +} From a374860cf796b5fe32fd2a9874d43b7026e4bcb6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 11 Jul 2024 15:49:50 +0200 Subject: [PATCH 10/10] tweak message --- R/stat-smooth.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/stat-smooth.R b/R/stat-smooth.R index 776ff89481..a1c4cd1e38 100644 --- a/R/stat-smooth.R +++ b/R/stat-smooth.R @@ -115,7 +115,8 @@ StatSmooth <- ggproto("StatSmooth", Stat, cli::cli_inform(c( "The {.arg method} was set to {.val gam}, but {.pkg mgcv} is not installed.", "!" = "Falling back to {.code method = \"lm\"}.", - i = "Change the {.arg method} argument to silence this message." + i = "Install {.pkg mgcv} or change the {.arg method} argument to \\ + resolve this issue." )) method <- "lm" }