From bcb87fc120becf836f130fc6c84edca577b11cfd Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 26 Aug 2024 15:18:51 +0200
Subject: [PATCH] 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 5824b1df9e300d246e8adeae37a2d462770f199f.

* homebrew an install prompt

* change fallback

* fix `gam_method()` in absence of mgcv

* tweak message
---
 DESCRIPTION                       |  2 +-
 NEWS.md                           |  1 +
 R/stat-smooth.R                   | 66 +++++++++++++++++++------------
 R/utilities.R                     | 29 ++++++++++++++
 tests/testthat/test-geom-smooth.R | 14 +++++++
 5 files changed, 86 insertions(+), 26 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index d97ce7e689..6a14039f20 100644
--- a/DESCRIPTION
+++ b/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,
diff --git a/NEWS.md b/NEWS.md
index ffdd113269..6a66ca97d4 100644
--- a/NEWS.md
+++ b/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 
diff --git a/R/stat-smooth.R b/R/stat-smooth.R
index 9c72d3570c..147bd06e41 100644
--- a/R/stat-smooth.R
+++ b/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
+  }
+}
diff --git a/R/utilities.R b/R/utilities.R
index a3357e6119..0bddb4b4c6 100644
--- a/R/utilities.R
+++ b/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)
+}
diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R
index 5f8282c176..42c82108c7 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 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", {