Move {mgcv} to suggests (#5987)

* move all method setup to `setup_params()`

* fallback to `method = "lm"` in absence of {mgcv}

* adjust tests

* move {mgcv} from Imports to Suggests

* add news bullet

* Revert "fallback to `method = "lm"` in absence of {mgcv}"

This reverts commit 5824b1d.

* homebrew an install prompt

* change fallback

* fix `gam_method()` in absence of mgcv

* tweak message

DESCRIPTION

@@ -39,7 +39,6 @@ Imports:
  isoband,
  lifecycle (> 1.0.1),
  MASS,
- mgcv,
  rlang (>= 1.1.0),
  scales (>= 1.3.0),
  stats,
@@ -55,6 +54,7 @@ Suggests:
  knitr,
  mapproj,
  maps,
+ mgcv,
  multcomp,
  munsell,
  nlme,

NEWS.md

@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* Moved {mgcv} from Imports to Suggests (@teunbrand, #5986)
 * New `reset_geom_defaults()` and `reset_stat_defaults()` to restore all geom or
  stat default aesthetics at once (@teunbrand, #5975).
 * `facet_wrap()` can have `space = "free_x"` with 1-row layouts and 

R/stat-smooth.R

@@ -95,36 +95,63 @@ 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 (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 = "Install {.pkg mgcv} or change the {.arg method} argument to \\
+ resolve this issue."
+ ))
+ method <- "lm"
  }
 
  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 +186,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(
@@ -205,4 +215,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
+ }
+}

R/utilities.R

@@ -846,3 +846,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)
+}

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 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_message(
+ ggplot_build(p), regexp = "Falling back to `method = \"lm\"`"
+ ),
+ is_installed = function(...) FALSE
+ )
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("geom_smooth() works with alternative stats", {