Make fit_LMCurve() and fit_CWCurve() more resilient to plot failures.

Author: mcol

NEWS.Rmd

@@ -252,6 +252,8 @@ to control the saving of the component contribution matrix in the RLum.Results
 object it returns. This is now disabled by default: to restore the previous
 behaviour, add `method_control = list(export.comp.contrib.matrix = TRUE)` to
 the function call (fixed in #573).
+* In case of plot failure the function now is able to recover gracefully and
+produce an output object (#574, fixed in #578).
 
 ### `fit_EmissionSpectra()`
 * The function can now return a data frame with the values of all curves
@@ -265,6 +267,9 @@ to control the saving of the component contribution matrix in the RLum.Results
 object it returns. This is now disabled by default: to restore the previous
 behaviour, add `method_control = list(export.comp.contrib.matrix = TRUE)` to
 the function call (fixed in #573).
+* In case of plot failure the function now is able to recover gracefully and
+produce an output object (#574, fixed in #578; thanks to @LumTKO for
+reporting).
 
 ### `get_RLum()`
 * If `get_RLum()` with `subset` was used on info objects of an `RLum.Analysis-class` object it

NEWS.md

@@ -296,6 +296,8 @@
   to restore the previous behaviour, add
   `method_control = list(export.comp.contrib.matrix = TRUE)` to the
   function call (fixed in \#573).
+- In case of plot failure the function now is able to recover gracefully
+  and produce an output object (#574, fixed in \#578).
 
 ### `fit_EmissionSpectra()`
 
@@ -312,6 +314,9 @@
   to restore the previous behaviour, add
   `method_control = list(export.comp.contrib.matrix = TRUE)` to the
   function call (fixed in \#573).
+- In case of plot failure the function now is able to recover gracefully
+  and produce an output object (#574, fixed in \#578; thanks to @LumTKO
+  for reporting).
 
 ### `get_RLum()`
 

R/fit_CWCurve.R

@@ -686,10 +686,6 @@ fit_CWCurve<- function(
         "cont.sum")
 
     }#endif :: (exists("fit"))
-
-  }else{
-    if (verbose)
-      .throw_message("Fitting failed, plot without fit produced")
   }
 
   ##============================================================================##
@@ -698,7 +694,8 @@ fit_CWCurve<- function(
   if(plot==TRUE){
 
     ##grep par parameters
-    par.default <- par(no.readonly = TRUE)
+    par.default <- par()[c("mfrow", "cex", "mar", "omi", "oma")]
+    on.exit(par(par.default), add = TRUE)
 
     ##set colors gallery to provide more colors
     col <- get("col", pos = .LuminescenceEnv)
@@ -709,18 +706,23 @@ fit_CWCurve<- function(
       layout(matrix(c(1,2,3),3,1,byrow=TRUE),c(1.6,1,1), c(1,0.3,0.4),TRUE)
       par(oma = c(1, 1, 1, 1), mar = c(0, 4, 3, 0))
     }
-
-    ##==uppper plot==##
+    ##== upper plot ==##
     ##open plot area
-
-    plot(NA,NA,
+    plot_check <- try(plot(NA, NA,
          xlim=c(min(x),max(x)),
          ylim = c(ifelse(log == "xy", 1, 0), max(y)),
          xlab = ifelse(inherits(fit, "try-error"), xlab, ""),
          xaxt = ifelse(inherits(fit, "try-error"), "s", "n"),
          ylab=ylab,
          main=main,
-         log=log)
+         log = log), silent = TRUE)
+
+    if (is(plot_check, "try-error")) {
+      ## reset the graphic device if plotting failed
+      .throw_message("Figure margins too large or plot area too small, ",
+                     "nothing plotted")
+      grDevices::dev.off()
+    } else {
 
     ##plotting measured signal
     points(x,y,pch=20, col="grey")
@@ -754,15 +756,22 @@ fit_CWCurve<- function(
       ##==lower plot==##
       ##plot residuals
       par(mar=c(4.2,4,0,0))
-      plot(x,residuals(fit),
+      plot_check2 <- try(plot(x,residuals(fit),
            xlim=c(min(x),max(x)),
            xlab=xlab,
            type="l",
            col="grey",
            ylab="Residual [a.u.]",
            lwd=2,
            log=if(log=="x" | log=="xy"){log="x"}else{""}
-      )
+      ), silent = TRUE)
+
+      if (is(plot_check2, "try-error")) {
+        ## reset the graphic device if plotting failed
+        .throw_message("Figure margins too large or plot area too small, ",
+                       "nothing plotted")
+        grDevices::dev.off()
+      } else {
 
       ##add 0 line
       abline(h=0)
@@ -793,11 +802,14 @@ fit_CWCurve<- function(
                 col = col[i+1])
       }
       rm(stepping)
+      } # end if (plot_check2)
 
+    } else {
+      if (verbose)
+        .throw_message("Fitting failed, plot without fit produced")
     }#end if try-error for fit
 
-    par(par.default)
-    rm(par.default)
+    } # end if (plot_check)
   }
 
   ##============================================================================##

R/fit_LMCurve.R

@@ -918,7 +918,7 @@ fit_LMCurve<- function(
 
     ##==upper plot==##
     ##open plot area
-    plot(
+    plot_check <- try(plot(
       NA,
       NA,
       xlim = xlim,
@@ -928,7 +928,14 @@ fit_LMCurve<- function(
       main = main,
       log = log,
       ylab = ylab
-    )#endplot
+    ), silent = TRUE)
+
+    if (is(plot_check, "try-error")) {
+      ## reset the graphic device if plotting failed
+      .throw_message("Figure margins too large or plot area too small, ",
+                     "nothing plotted")
+      grDevices::dev.off()
+    } else {
 
     mtext(side=3,sample_code,cex=0.8*cex)
 
@@ -1031,6 +1038,8 @@ fit_LMCurve<- function(
     }#end if try-error for fit
 
     if (fun == TRUE) sTeve() # nocov
+
+    } # end if (plot_check)
   }
   ##-----------------------------------------------------------------------------
   ##remove objects

tests/testthat/test_fit_CWCurve.R

@@ -1,5 +1,6 @@
 ## load data
 data(ExampleData.CW_OSL_Curve, envir = environment())
+data(ExampleData.FittingLM, envir = environment())
 
 test_that("input validation", {
   testthat::skip_on_cran()
@@ -77,6 +78,14 @@ test_that("check functionality", {
   ## more coverage
   expect_message(fit_CWCurve(ExampleData.CW_OSL_Curve[1, ]),
                  "Error: Fitting failed, plot without fit produced")
+
+  pdf(tempfile(), width = 1, height = 1)
+  expect_message(fit_CWCurve(values.curve, n.components.max = 3,
+                             verbose = FALSE),
+                 "Figure margins too large or plot area too small")
+  pdf(tempfile(), width = 1, height = 1)
+  expect_message(fit_CWCurve(ExampleData.CW_OSL_Curve, verbose = FALSE),
+                 "Figure margins too large or plot area too small")
 })
 
 test_that("regression tests", {

tests/testthat/test_fit_LMCurve.R

@@ -95,6 +95,9 @@ test_that("snapshot tests", {
   })
   expect_message(fit_LMCurve(values.curve[1:15, ], main = ""),
                  "Fitting failed, plot without fit produced")
+  pdf(tempfile(), width = 1, height = 1)
+  expect_message(fit_LMCurve(values.curve, verbose = FALSE),
+                 "Figure margins too large or plot area too small")
 
   SW({
   skip_on_os("mac")