Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Move {mgcv} to suggests #5987

Merged
merged 12 commits into from
Aug 26, 2024
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,6 @@ Imports:
isoband,
lifecycle (> 1.0.1),
MASS,
mgcv,
rlang (>= 1.1.0),
scales (>= 1.3.0),
stats,
Expand All @@ -55,6 +54,7 @@ Suggests:
knitr,
mapproj,
maps,
mgcv,
multcomp,
munsell,
nlme,
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
66 changes: 41 additions & 25 deletions R/stat-smooth.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
},

Expand Down Expand Up @@ -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(
Expand Down Expand Up @@ -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
}
}
29 changes: 29 additions & 0 deletions R/utilities.R
Original file line number Diff line number Diff line change
Expand Up @@ -846,3 +846,32 @@
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))]

Check warning on line 861 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L861

Added line #L861 was not covered by tests

message <- "The {.pkg {pkg}} package{?s} {?is/are} required"
if (is.null(reason)) {
message <- paste0(message, ".")

Check warning on line 865 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L863-L865

Added lines #L863 - L865 were not covered by tests
} else {
message <- paste0(message, " ", reason)

Check warning on line 867 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L867

Added line #L867 was not covered by tests
}
question <- "Would you like to install {cli::qty(pkg)}{?it/them}?"

Check warning on line 869 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L869

Added line #L869 was not covered by tests

cli::cli_bullets(c("!" = message, "i" = question))
if (utils::menu(c("Yes", "No")) != 1) {
return(FALSE)

Check warning on line 873 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L871-L873

Added lines #L871 - L873 were not covered by tests
}
utils::install.packages(pkg)
is_installed(pkg)

Check warning on line 876 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L875-L876

Added lines #L875 - L876 were not covered by tests
}
14 changes: 14 additions & 0 deletions tests/testthat/test-geom-smooth.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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", {
Expand Down
Loading