R/plot_GrowthCurve.R

In Luminescence: Comprehensive Luminescence Dating Data Analysis

#' @title Fit and plot a dose-response curve for luminescence data (Lx/Tx against dose)
#'
#' @description
#' A dose-response curve is produced for luminescence measurements using a
#' regenerative or additive protocol. This is a wrapper around
#' [Luminescence::fit_DoseResponseCurve] and [Luminescence::plot_DoseResponseCurve].
#'
#' @inheritParams fit_DoseResponseCurve
#'
#' @param output.plot [logical] (*with default*):
#' enable/disable the plot output.
#'
#' @param output.plotExtended [logical] (*with default*):
#' If `TRUE` (default), 3 plots on one plot area are provided:
#' 1. the dose-response curve,
#' 2. a histogram from Monte Carlo error simulation and
#' 3. a test dose response plot.
#'
#' If `FALSE`, just the growth curve will be plotted.
#'
#' @param plot_singlePanels [logical] (*with default*):
#' single plot output (`TRUE/FALSE`) to allow for plotting the results in
#' single plot windows. Requires `output.plotExtended = TRUE`.
#'
#' @param ... Further arguments to [Luminescence::fit_DoseResponseCurve]
#' (`fit.force_through_origin`, `fit_weights`, `fit.includingRepeatedRegPoints`,
#' `fit.NumberRegPoints`, `fit.NumberRegPointsReal`, `fit_bounds`, `txtProgressBar`)
#' and to [Luminescence::plot_DoseResponseCurve] (`xlim`, `ylim`, `main`,
#' `mtext`, `xlab`, `ylab`, `log`, `legend` (`TRUE/FALSE`), `legend.pos`,
#' `reg_points_pch`, `density_polygon` (`TRUE/FALSE`), `density_polygon_col`,
#' `density_rug` (`TRUE`/`FALSE`), `lwd_drc`, `col_drc`, `lty_drc`,
#' `box` (`TRUE`/`FALSE`)).
#'
#' @return
#' Along with a plot (if wanted) the [Luminescence::RLum.Results-class] object
#' produced by [Luminescence::fit_DoseResponseCurve] is returned invisibly.
#'
#' @section Function version: 1.2.3
#'
#' @author
#' Sebastian Kreutzer, F2.1 Geophysical Parametrisation/Regionalisation, LIAG - Institute for Applied Geophysics (Germany)\cr
#' Michael Dietze, GFZ Potsdam (Germany) \cr
#' Marco Colombo, Institute of Geography, Heidelberg University (Germany)
#'
#' @references
#' Berger, G.W., Huntley, D.J., 1989. Test data for exponential fits. Ancient TL 7, 43-46.
#'
#' Guralnik, B., Li, B., Jain, M., Chen, R., Paris, R.B., Murray, A.S., Li, S.-H., Pagonis, P.,
#' Herman, F., 2015. Radiation-induced growth and isothermal decay of infrared-stimulated luminescence
#' from feldspar. Radiation Measurements 81, 224-231.
#'
#' Pagonis, V., Kitis, G., Chen, R., 2020. A new analytical equation for the dose response of dosimetric materials,
#' based on the Lambert W function. Journal of Luminescence 225, 117333. \doi{10.1016/j.jlumin.2020.117333}
#'
#' @seealso [Luminescence::fit_DoseResponseCurve], [Luminescence::plot_DoseResponseCurve]
#'
#' @examples
#'
#' ##(1) plot growth curve for a dummy dataset
#' data(ExampleData.LxTxData, envir = environment())
#' plot_GrowthCurve(LxTxData)
#'
#' ##(1b) horizontal plot arrangement
#' layout(mat = matrix(c(1,1,2,3), ncol = 2))
#' plot_GrowthCurve(LxTxData, plot_singlePanels = TRUE)
#'
#' ##(2) plot the growth curve with pdf output - uncomment to use
#' ##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special")
#' plot_GrowthCurve(LxTxData)
#' ##dev.off()
#'
#' ##(3) plot the growth curve with pdf output - uncomment to use, single output
#' ##pdf(file = "~/Desktop/Growth_Curve_Dummy.pdf", paper = "special")
#' temp <- plot_GrowthCurve(LxTxData, plot_singlePanels = TRUE)
#' ##dev.off()
#'
#' ##(4) plot resulting function for given interval x
#' x <- seq(1,10000, by = 100)
#' plot(
#'  x = x,
#'  y = eval(temp$Formula),
#'  type = "l"
#' )
#'
#' ##(5) plot using the 'extrapolation' mode
#' LxTxData[1,2:3] <- c(0.5, 0.001)
#' print(plot_GrowthCurve(LxTxData, mode = "extrapolation"))
#'
#' ##(6) plot using the 'alternate' mode
#' LxTxData[1,2:3] <- c(0.5, 0.001)
#' print(plot_GrowthCurve(LxTxData, mode = "alternate"))
#'
#' @export
plot_GrowthCurve <- function(
  object,
  mode = "interpolation",
  fit.method = "SSE",
  output.plot = TRUE,
  output.plotExtended = TRUE,
  plot_singlePanels = FALSE,
  verbose = TRUE,
  n.MC = 100,
  ...
) {
  .set_function_name("plot_GrowthCurve")
  on.exit(.unset_function_name(), add = TRUE)

  ## deprecated argument
  extraArgs <- list(...)
  if ("sample" %in% names(extraArgs)) {
    object <- extraArgs$sample
    .deprecated(old = "sample", new = "object", since = "1.2.0")
  }

  ## input validation
  .validate_logical_scalar(output.plot)
  .validate_logical_scalar(output.plotExtended)
  .validate_logical_scalar(plot_singlePanels)
  .validate_logical_scalar(verbose)

  ## remaining input validation occurs inside the fitting function
  fit <- fit_DoseResponseCurve(object, mode, fit.method,
                               verbose = verbose, n.MC = n.MC, ...)

  if (is.null(fit)) {
    if (verbose)
      .throw_message("Fitting failed, NULL returned")
    return(NULL)
  }

  if (output.plot) {
    plot_DoseResponseCurve(fit, plot_extended = output.plotExtended,
                           plot_singlePanels = plot_singlePanels,
                           verbose = verbose, ...)
  }

  invisible(fit)
}