Make the export of the component contribution matrix optional.

This can be controlled via option export.comp.contrib.matrix in the
method_control argument of fit_CWCurve() and fit_LMCurve().

Author: mcol

NEWS.Rmd

@@ -247,12 +247,24 @@ in `confint()` failed. This has now been fixed, and in cases of failures we
 report the error message received from `confint()` (#509, fixed in #510).
 * Argument `output.terminal` has been renamed to `verbose` for consistency
 with other functions.
+* The function has gained the new `method_control` argument, which can be used
+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).
 
 ### `fit_EmissionSpectra()`
 * The function can now return a data frame with the values of all curves
 plotted, so that it's much easier to produce alternative plots, by setting
 option `export.plot.data = TRUE` within the `method_control` argument (#569,
-fixed in #570).
+fixed in #570 and #573).
+
+### `fit_LMCurve()`
+* The function has gained the new `method_control` argument, which can be used
+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).
 
 ### `get_RLum()`
 * If `get_RLum()` with `subset` was used on info objects of an `RLum.Analysis-class` object it

NEWS.md

@@ -290,13 +290,28 @@
   fixed in \#510).
 - Argument `output.terminal` has been renamed to `verbose` for
   consistency with other functions.
+- The function has gained the new `method_control` argument, which can
+  be used 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).
 
 ### `fit_EmissionSpectra()`
 
 - The function can now return a data frame with the values of all curves
   plotted, so that it’s much easier to produce alternative plots, by
   setting option `export.plot.data = TRUE` within the `method_control`
-  argument (#569, fixed in \#570).
+  argument (#569, fixed in \#570 and \#573).
+
+### `fit_LMCurve()`
+
+- The function has gained the new `method_control` argument, which can
+  be used 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).
 
 ### `get_RLum()`
 

R/fit_CWCurve.R

@@ -92,6 +92,11 @@
 #' @param plot [logical] (*with default*):
 #' enable/disable the plot output.
 #'
+#' @param method_control [list] (*optional*): options to control the output
+#' produced. Currently only the 'export.comp.contrib.matrix' (logical) option
+#' is supported, to enable/disable export of the component contribution
+#' matrix.
+#'
 #' @param ... further arguments and graphical parameters passed to [plot].
 #'
 #' @return
@@ -115,6 +120,7 @@
 #' `component.contribution.matrix`:
 #' [matrix] containing the values for the component to sum contribution plot
 #' (`$component.contribution.matrix`).
+#' Produced only if `method_control$export.comp.contrib.matrix = TRUE`).
 #'
 #' Matrix structure:\cr
 #' Column 1 and 2: time and `rev(time)` values \cr
@@ -135,7 +141,7 @@
 #' The function **does not** ensure that the fitting procedure has reached a
 #' global minimum rather than a local minimum!
 #'
-#' @section Function version: 0.5.3
+#' @section Function version: 0.5.4
 #'
 #' @author
 #' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)
@@ -182,6 +188,7 @@ fit_CWCurve<- function(
   verbose = TRUE,
   output.terminalAdvanced = TRUE,
   plot = TRUE,
+  method_control = list(),
   ...
 ) {
   .set_function_name("fit_CWCurve")
@@ -212,6 +219,7 @@ fit_CWCurve<- function(
   .validate_logical_scalar(verbose)
   .validate_logical_scalar(output.terminalAdvanced)
   .validate_logical_scalar(plot)
+  .validate_class(method_control, "list")
 
   # Deal with extra arguments -----------------------------------------------
 
@@ -230,6 +238,9 @@ fit_CWCurve<- function(
   ylab <- if("ylab" %in% names(extraArgs)) {extraArgs$ylab} else
   {paste("OSL [cts/",round(max(x)/length(x), digits = 2)," s]",sep="")}
 
+  method_control <- modifyList(x = list(export.comp.contrib.matrix = FALSE),
+                               val = method_control)
+
   if ("output.path" %in% names(extraArgs))
     .throw_warning("Argument 'output.path' no longer supported, ignored")
 
@@ -793,6 +804,9 @@ fit_CWCurve<- function(
   ## Return Values
   ##============================================================================##
 
+  if (!method_control$export.comp.contrib.matrix) {
+    component.contribution.matrix <- NA
+  }
   newRLumResults.fit_CWCurve <- set_RLum(
     class = "RLum.Results",
     data = list(

R/fit_LMCurve.R

@@ -144,15 +144,20 @@
 #' see Details). **Note:** requires input for `values.bg`.
 #'
 #' @param verbose [logical] (*with default*):
-#'  terminal output with fitting results.
+#' enable/disable output to the terminal.
 #'
 #' @param plot [logical] (*with default*):
-#' returns a plot of the fitted curves.
+#' enable/disable the plot output.
 #'
 #' @param plot.BG [logical] (*with default*):
 #' returns a plot of the background values with the fit used for the
 #' background subtraction.
 #'
+#' @param method_control [list] (*optional*): options to control the output
+#' produced. Currently only the 'export.comp.contrib.matrix' (logical) option
+#' is supported, to enable/disable export of the component contribution
+#' matrix.
+#'
 #' @param ... Further arguments that may be passed to the plot output, e.g.
 #' `xlab`, `xlab`, `main`, `log`.
 #'
@@ -166,6 +171,7 @@
 #' `.. $fit` : nls ([nls] object)\cr
 #' `.. $component_matrix` : [matrix] with numerical xy-values of the single fitted components with the resolution of the input data
 #' `.. $component.contribution.matrix` : [list] component distribution matrix
+#'  (produced only if `method_control$export.comp.contrib.matrix = TRUE`)
 #'
 #' **`info:`**
 #'
@@ -188,7 +194,7 @@
 #' global minimum rather than a local minimum! In any case of doubt, the use of
 #' manual start values is highly recommended.
 #'
-#' @section Function version: 0.3.4
+#' @section Function version: 0.3.5
 #'
 #' @author
 #' Sebastian Kreutzer, Institute of Geography, Heidelberg University (Germany)
@@ -259,6 +265,7 @@ fit_LMCurve<- function(
   verbose = TRUE,
   plot = TRUE,
   plot.BG = FALSE,
+  method_control = list(),
   ...
 ) {
   .set_function_name("fit_LMCurve")
@@ -296,6 +303,10 @@ fit_LMCurve<- function(
   fit.method <- .validate_args(fit.method, c("port", "LM"))
   bg.subtraction <- .validate_args(bg.subtraction,
                                    c("polynomial", "linear", "channel"))
+  .validate_logical_scalar(verbose)
+  .validate_logical_scalar(plot)
+  .validate_logical_scalar(plot.BG)
+  .validate_class(method_control, "list")
 
   ## Set plot format parameters -----------------------------------------------
   extraArgs <- list(...) # read out additional arguments list
@@ -335,6 +346,9 @@ fit_LMCurve<- function(
 
   fun <- if ("fun" %in% names(extraArgs)) extraArgs$fun else FALSE # nocov
 
+  method_control <- modifyList(x = list(export.comp.contrib.matrix = FALSE),
+                               val = method_control)
+
   # layout safety settings
   par.default <- par()[c("mfrow", "cex", "mar", "omi", "oma")]
   on.exit(par(par.default), add = TRUE)
@@ -1025,6 +1039,10 @@ fit_LMCurve<- function(
   ##============================================================================#
   ## Return Values
   ##============================================================================#
+
+  if (!method_control$export.comp.contrib.matrix) {
+    component.contribution.matrix <- NA
+  }
   newRLumResults.fit_LMCurve <- set_RLum(
     class = "RLum.Results",
     data = list(

man/fit_CWCurve.Rd

@@ -43,6 +43,8 @@ test_that("check functionality", {
   expect_equal(round(fit$data$I01, digits = 0), 2388, tolerance = 1)
   expect_equal(round(fit$data$lambda1, digits = 1), 4.6, tolerance = 1)
   expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1)
+  expect_type(fit@data$component.contribution.matrix, "list")
+  expect_equal(fit@data$component.contribution.matrix[[1]], NA)
 
   ## RLum.Data.Curve object
   curve <- set_RLum("RLum.Data.Curve",
@@ -54,6 +56,7 @@ test_that("check functionality", {
                      main = "CW Curve Fit",
                      n.components.max = 4,
                      log = "x",
+                     method_control = list(export.comp.contrib.matrix = TRUE),
                      verbose = FALSE,
                      plot = FALSE)
   expect_s4_class(fit, "RLum.Results")
@@ -62,6 +65,7 @@ test_that("check functionality", {
   expect_equal(round(fit$data$I01, digits = 0), 2388, tolerance = 1)
   expect_equal(round(fit$data$lambda1, digits = 1), 4.6, tolerance = 1)
   expect_equal(round(fit$data$`pseudo-R^2`, digits = 0), 1)
+  expect_length(fit@data$component.contribution.matrix[[1]], 9000)
 
   SW({
   expect_warning(fit_CWCurve(ExampleData.CW_OSL_Curve, fit.method = "LM",

man/fit_LMCurve.Rd

@@ -48,6 +48,8 @@ test_that("snapshot tests", {
   set.seed(1)
   fit <- fit_LMCurve(values.curve, values.bg = values.curveBG,
                      n.components = 3, log = "x",
+                     method_control = list(
+                         export.comp.contrib.matrix = TRUE),
                      start_values = data.frame(Im = c(170,25,400),
                                                xm = c(56,200,1500)))
   })
@@ -59,6 +61,8 @@ test_that("snapshot tests", {
                       n.components = 3,
                       log = "x",
                       fit.method = "LM",
+                      method_control = list(
+                          export.comp.contrib.matrix = TRUE),
                       plot = FALSE)
   })
   expect_snapshot_RLum(fit2, tolerance = snapshot.tolerance)
@@ -72,6 +76,8 @@ test_that("snapshot tests", {
 
   set.seed(1)
   expect_snapshot_RLum(fit_LMCurve(values.curve, values.bg = values.curveBG,
+                                   method_control = list(
+                                       export.comp.contrib.matrix = TRUE),
                                    plot.BG = TRUE, bg.subtraction = "linear"),
                        tolerance = snapshot.tolerance)
 
@@ -94,10 +100,14 @@ test_that("snapshot tests", {
   skip_on_os("mac")
   expect_snapshot_RLum(fit_LMCurve(values.curve, values.bg = values.curveBG,
                                    xlim = c(0, 4000), ylim = c(0, 600), cex = 0.9,
+                                   method_control = list(
+                                       export.comp.contrib.matrix = TRUE),
                                    fit.calcError = TRUE),
                        tolerance = snapshot.tolerance)
   expect_snapshot_RLum(fit_LMCurve(values.curve, values.bg = values.curveBG,
                                    plot.BG = TRUE, input.dataType = "pLM",
+                                   method_control = list(
+                                       export.comp.contrib.matrix = TRUE),
                                    bg.subtraction = "channel"),
                        tolerance = snapshot.tolerance)
   skip_on_os("windows")