stat_smooth() drops failed groups (#5371)

* Return NULL when fit fails

* Add test

* Add news bullet

* Guarantee clean error in test

* Use `try_fetch()`

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* Failing to fit or predict in `stat_smooth()` now gives a warning and omits
+ the failed group, instead of throwing an error (@teunbrand, #5352).
+
 * `resolution()` has a small tolerance, preventing spuriously small resolutions 
  due to rounding errors (@teunbrand, #2516).
 

R/stat-smooth.R

@@ -171,14 +171,25 @@ StatSmooth <- ggproto("StatSmooth", Stat,
  method.args$method <- "REML"
  }
 
- model <- inject(method(
- formula,
- data = data,
- weights = weight,
- !!!method.args
- ))
-
- prediction <- predictdf(model, xseq, se, level)
+ prediction <- try_fetch(
+ {
+ model <- inject(method(
+ formula,
+ data = data,
+ weights = weight,
+ !!!method.args
+ ))
+ predictdf(model, xseq, se, level)
+ },
+ error = function(cnd) {
+ cli::cli_warn("Failed to fit group {data$group[1]}.", parent = cnd)
+ NULL
+ }
+ )
+ if (is.null(prediction)) {
+ return(NULL)
+ }
+
  prediction$flipped_aes <- flipped_aes
  flip_data(prediction, flipped_aes)
  },

tests/testthat/test-geom-smooth.R

@@ -77,6 +77,22 @@ test_that("default smoothing methods for small and large data sets work", {
  expect_equal(plot_data$y, as.numeric(out))
 })
 
+test_that("geom_smooth() works when one group fails", {
+ # Group A fails, B succeeds
+ df <- data_frame0(
+ x = c(1, 2, 1, 2, 3),
+ y = c(1, 2, 3, 2, 1),
+ g = rep(c("A", "B"), 2:3)
+ )
+ p <- ggplot(df, aes(x, y, group = g)) +
+ geom_smooth(method = "loess", formula = y ~ x)
+
+ suppressWarnings(
+ expect_warning(ld <- layer_data(p), "Failed to fit group 1")
+ )
+ expect_equal(unique(ld$group), 2)
+ expect_gte(nrow(ld), 2)
+})
 
 # Visual tests ------------------------------------------------------------
 

tests/testthat/test-stats.R

@@ -5,13 +5,9 @@ test_that("plot succeeds even if some computation fails", {
  b1 <- ggplot_build(p1)
  expect_equal(length(b1$data), 1)
 
- p2 <- p1 + geom_smooth()
+ p2 <- p1 + stat_summary(fun = function(x) stop("Failed computation"))
 
- # TODO: These multiple warnings should be summarized nicely. Until this gets
- # fixed, this test ignores all the following errors than the first one.
- suppressWarnings(
- expect_warning(b2 <- ggplot_build(p2), "Computation failed")
- )
+ expect_warning(b2 <- ggplot_build(p2), "Computation failed")
  expect_equal(length(b2$data), 2)
 })