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)
 })