From 88d05175530b6b587d70e62df1301668e79dd6a3 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 2 Oct 2023 14:32:15 +0200
Subject: [PATCH] `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                           |  3 +++
 R/stat-smooth.R                   | 27 +++++++++++++++++++--------
 tests/testthat/test-geom-smooth.R | 16 ++++++++++++++++
 tests/testthat/test-stats.R       |  8 ++------
 4 files changed, 40 insertions(+), 14 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index f747c46d9a..374936e7d9 100644
--- a/NEWS.md
+++ b/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).
 
diff --git a/R/stat-smooth.R b/R/stat-smooth.R
index 691d16fa02..a2180f2dc8 100644
--- a/R/stat-smooth.R
+++ b/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)
   },
diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R
index b0f4bbf44c..ca57bd2e38 100644
--- a/tests/testthat/test-geom-smooth.R
+++ b/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 ------------------------------------------------------------
 
diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R
index 2cd71ab089..6c46bb38df 100644
--- a/tests/testthat/test-stats.R
+++ b/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)
 })