#' @title (Un-)logged minimum age model (MAM) after Galbraith et al. (1999)
#'
#' @description
#' Function to fit the (un-)logged three or four parameter minimum dose model
#' (MAM-3/4) to De data.
#'
#' **Parameters**
#'
#' This model has four parameters:
#' \tabular{rl}{
#' `gamma`: \tab minimum dose on the log scale \cr
#' `mu`: \tab mean of the non-truncated normal distribution \cr
#' `sigma`: \tab spread in ages above the minimum \cr
#' `p0`: \tab proportion of grains at gamma \cr }
#'
#' If `par=3` (default) the 3-parameter minimum age model is applied,
#' where `gamma=mu`. For `par=4` the 4-parameter model is applied instead.
#'
#' **(Un-)logged model**
#'
#' In the original version of the minimum dose model, which is applied if
#' `log = TRUE` (default), the basic data are the natural
#' logarithms of the De estimates and relative standard errors of the De
#' estimates. The value for `sigmab` must be provided as a ratio
#' (e.g, 0.2 for 20 %).
#'
#' If `log=FALSE`, the modified un-logged model will be applied instead. This
#' has essentially the same form as the original version, but  `gamma` and
#' `sigma` are in Gy and `gamma` becomes the minimum true dose in the
#' population.
#' **Note:** the un-logged model requires `sigmab` to be in the same
#' absolute unit as the provided De values (seconds or Gray).
#'
#' While the original (logged) version of the minimum dose
#' model may be appropriate for most samples (i.e. De distributions), the
#' modified (un-logged) version is specially designed for modern-age and young
#' samples containing negative, zero or near-zero De estimates (Arnold et al.
#' 2009, p. 323).
#'
#' **Initial values and boundaries**
#'
#' The log-likelihood calculations use the [nlminb] function for box-constrained
#' optimisation using PORT routines.  Accordingly, initial values for the four
#' parameters can be specified via `init.values`. If no values are
#' provided for `init.values`, reasonable starting values are estimated
#' from the input data.  If the final estimates of *gamma*, *mu*,
#' *sigma* and *p0* are totally off target, consider providing custom
#' starting values via `init.values`.
#'
#' The boundaries for individual model parameters need not be specified
#' explicitly. To override the default boundary values, provide arguments
#' `gamma.lower`, `gamma.upper`, `sigma.lower`, `sigma.upper`,
#' `p0.lower`, `p0.upper`, `mu.lower` and `mu.upper`.
#'
#' **Bootstrap**
#'
#' When `bootstrap=TRUE` the function applies the bootstrapping method as
#' described in Cunningham & Wallinga (2012). The minimum age model produces
#' `bs.M` first-level bootstrap replicates (1000 by default) and `bs.N`
#' second-level replicates (`3 * bs.M` by default), with an uncertainty
#' `sigma.sd` on the overdispersion parameter (0.04 by default). These values
#' can be changed by using arguments `bs.M`, `bs.N` and `sigmab.sd`,
#' respectively. The bandwidth of the kernel density estimate can be specified
#' with `bs.h`. By default, this is calculated as:
#'
#' \deqn{h = (2*\sigma_{DE})/\sqrt{n}}
#'
#' **Multicore support**
#'
#' Parallel processing can be enabled by setting `multicore = TRUE`. By default,
#' the number of logical CPU cores is detected automatically, but it can be
#' overridden with the `cores` argument. Multicore processing is supported
#' only when `bootstrap = TRUE`, and spawns one R process per core to compute
#' MAM estimates for each of the `N * M` bootstrap replicates. Note that this
#' feature is experimental and may not work on all systems. Performance gains
#' grow with the number of bootstrap replicates, but each additional core (R
#' process) increases memory usage. When memory is insufficient, overall
#' performance can degrade severely.
#'
#' **Likelihood profiles**
#'
#' The likelihood profiles are generated and plotted by the `bbmle` package.
#' The profile likelihood plots look different to ordinary profile likelihood as
#'
#' "`[...]` the plot method for likelihood profiles displays the square root of
#' the deviance difference (twice the difference in negative log-likelihood from
#' the best fit), so it will be V-shaped for cases where the quadratic approximation
#' works well `[...]`." (Bolker 2016).
#'
#' For more details on the profile likelihood
#' calculations and plots please see the vignettes of the `bbmle` package
#' (also available here: [https://CRAN.R-project.org/package=bbmle]().
#'
#' @param data [Luminescence::RLum.Results-class] or [data.frame] (**required**):
#' for [data.frame]: two columns with `(data[, 1])` and De error `(data[, 2])`.
#'
#' @param sigmab [numeric] (**required**):
#' additional spread in De values, representing the expected overdispersion in
#' the data should the sample be well-bleached (Cunningham & Wallinga 2012, p. 100).
#' **Note:** For the logged model (`log = TRUE`) this value must be
#' a fraction, e.g. 0.2 (= 20 %). If the un-logged model is used (`log = FALSE`),
#' `sigmab` must be provided in the same absolute units of the De values (seconds or Gray).
#' See details.
#'
#' @param log [logical] (*with default*):
#' whether the logged minimum dose model should be fit to De data (`TRUE` by
#' default).
#'
#' @param par [numeric] (*with default*):
#' number of parameters in the minimum age model, either 3 (default) or 4.
#'
#' @param bootstrap [logical] (*with default*):
#' apply the recycled bootstrap approach of Cunningham & Wallinga (2012).
#'
#' @param init.values [numeric] (*optional*):
#' a named list with starting values for `gamma`, `sigma`, `p0` and `mu`
#' (e.g. `list(gamma=100, sigma=1.5, p0=0.1, mu=100)`). If no values are
#' provided, reasonable values will be estimated from the data.
#' **Note:** the initial values must always be given in the absolute units.
#' If a logged model is applied (`log = TRUE`), the provided `init.values`
#' are automatically log-transformed.
#'
#' @param level [logical] (*with default*):
#' the confidence level required (defaults to 0.95).
#'
#' @param log.output [logical] (*with default*):
#' if `TRUE` and `log = TRUE`, the console output will also show the logged
#' values of the final parameter estimates and confidence intervals.
#'
#' @param plot [logical] (*with default*):
#' enable/disable the plot output.
#'
#' @param multicore [logical] (*with default*):
#' parallelize the computation of the bootstrap by creating a multicore cluster
#' (only considered if `bootstrap = TRUE`). By default, it uses all available
#' logical CPU cores, but this can be changed with the `cores` argument. Note
#' that this feature is experimental and may not work on all systems.
#'
#' @param ... (*optional*) further arguments for bootstrapping
#' (`bs.M`, `bs.N`, `bs.h`, `sigmab.sd`). See details for their usage.
#' Further arguments are
#' - `verbose`: enable/disable output to the terminal
#' - `debug`: enable/disable extended console output
#' - `cores`: number of cores to be used when `multicore=TRUE`
#'
#' @return Returns a plot (*optional*) and terminal output. In addition an
#' [Luminescence::RLum.Results-class] object is returned containing the
#' following elements:
#'
#' \item{$summary}{[data.frame] summary of all relevant model results.}
#' \item{$data}{[data.frame] original input data}
#' \item{$args}{[list] used arguments}
#' \item{$call}{[call] the function call}
#' \item{$mle}{[bbmle::mle2] object containing the maximum log likelihood functions for all parameters}
#' \item{$BIC}{[numeric] BIC score from the non-bootstrapped model}
#' \item{$confint}{[data.frame] confidence intervals for all parameters}
#' \item{$profile}{[stats::profile] the log likelihood profiles}
#' \item{$bootstrap}{[list] bootstrap results}
#'
#' The output should be accessed using the function [Luminescence::get_RLum].
#'
#' @note
#' The default starting values for *gamma*, *mu*, *sigma*
#' and *p0* may only be appropriate for some De data sets and may need to
#' be changed for other data. This is especially true when the un-logged
#' version is applied. \cr
#' Also note that all R warning messages are suppressed
#' when running this function. If the results seem odd consider re-running the
#' model with `debug=TRUE` which provides extended console output and
#' forwards all internal warning messages.
#'
#' @section Function version: 0.5.0
#'
#' @author
#' Christoph Burow, University of Cologne (Germany) \cr
#' Marco Colombo, Institute of Geography, Heidelberg University (Germany) \cr
#' Based on a rewritten S script of Rex Galbraith, 2010 \cr
#' The bootstrap approach is based on a MATLAB script by Alastair Cunningham,
#' who helped with implementation and cross-checking.
#'
#' @seealso [Luminescence::calc_CentralDose], [Luminescence::calc_CommonDose], [Luminescence::calc_FiniteMixture],
#' [Luminescence::calc_FuchsLang2001], [Luminescence::calc_MaxDose]
#'
#' @references
#' Arnold, L.J., Roberts, R.G., Galbraith, R.F. & DeLong, S.B.,
#' 2009. A revised burial dose estimation procedure for optical dating of young
#' and modern-age sediments. Quaternary Geochronology 4, 306-325.
#'
#' Galbraith, R.F. & Laslett, G.M., 1993. Statistical models for mixed fission
#' track ages. Nuclear Tracks Radiation Measurements 4, 459-470.
#'
#' Galbraith, R.F., Roberts, R.G., Laslett, G.M., Yoshida, H. & Olley, J.M.,
#' 1999. Optical dating of single grains of quartz from Jinmium rock shelter,
#' northern Australia. Part I: experimental design and statistical models.
#' Archaeometry 41, 339-364.
#'
#' Galbraith, R.F., 2005. Statistics for
#' Fission Track Analysis, Chapman & Hall/CRC, Boca Raton.
#'
#' Galbraith, R.F. & Roberts, R.G., 2012. Statistical aspects of equivalent dose and error
#' calculation and display in OSL dating: An overview and some recommendations.
#' Quaternary Geochronology 11, 1-27.
#'
#' Olley, J.M., Roberts, R.G., Yoshida, H., Bowler, J.M., 2006. Single-grain optical dating of grave-infill
#' associated with human burials at Lake Mungo, Australia. Quaternary Science
#' Reviews 25, 2469-2474.
#'
#' **Further reading**
#'
#' Arnold, L.J. & Roberts, R.G., 2009. Stochastic modelling of multi-grain equivalent dose
#' (De) distributions: Implications for OSL dating of sediment mixtures.
#' Quaternary Geochronology 4, 204-230.
#'
#' Bolker, B., 2016. Maximum likelihood estimation analysis with the bbmle package.
#' In: Bolker, B., R Development Core Team, 2016. bbmle: Tools for General Maximum Likelihood Estimation.
#' R package version 1.0.18. [https://CRAN.R-project.org/package=bbmle]()
#'
#' Bailey, R.M. & Arnold, L.J., 2006. Statistical modelling of single grain quartz De distributions and an
#' assessment of procedures for estimating burial dose. Quaternary Science
#' Reviews 25, 2475-2502.
#'
#' Cunningham, A.C. & Wallinga, J., 2012. Realizing the potential of fluvial archives using robust OSL chronologies.
#' Quaternary Geochronology 12, 98-106.
#'
#' Rodnight, H., Duller, G.A.T., Wintle, A.G. & Tooth, S., 2006. Assessing the reproducibility and accuracy
#' of optical dating of fluvial deposits.  Quaternary Geochronology 1, 109-120.
#'
#' Rodnight, H., 2008. How many equivalent dose values are needed to
#' obtain a reproducible distribution?. Ancient TL 26, 3-10.
#'
#' @examples
#'
#' ## Load example data
#' data(ExampleData.DeValues, envir = environment())
#'
#' # (1) Apply the minimum age model with minimum required parameters.
#' # By default, this will apply the un-logged 3-parameter MAM.
#' calc_MinDose(data = ExampleData.DeValues$CA1, sigmab = 0.1)
#'
#' \dontrun{
#' # (2) Re-run the model, but save results to a variable and turn
#' # plotting of the log-likelihood profiles off.
#' mam <- calc_MinDose(
#'  data = ExampleData.DeValues$CA1,
#'  sigmab = 0.1,
#'  plot = FALSE)
#'
#' # Show structure of the RLum.Results object
#' mam
#'
#' # Show summary table that contains the most relevant results
#' res <- get_RLum(mam, "summary")
#' res
#'
#' # Plot the log likelihood profiles retroactively, because before
#' # we set plot = FALSE
#' plot_RLum(mam)
#'
#' # Plot the dose distribution in an abanico plot and draw a line
#' # at the minimum dose estimate
#' plot_AbanicoPlot(data = mam,
#'                  main = "3-parameter Minimum Age Model",
#'                  polygon.col = "none",
#'                  hist = TRUE,
#'                  rug = TRUE,
#'                  summary = c("n", "mean", "mean.weighted", "median", "in.ci"),
#'                  centrality = res$de,
#'                  grid.col = "none",
#'                  line.col = "red",
#'                  line.label = paste0(round(res$de, 1), "\U00B1",
#'                                      round(res$de_err, 1), " Gy"),
#'                  bw = 0.1,
#'                  ylim = c(-25, 18),
#'                  summary.pos = "topleft",
#'                  mtext = bquote("Parameters: " ~
#'                                   sigma[b] == .(get_RLum(mam, "args")$sigmab) ~ ", " ~
#'                                   gamma == .(round(log(res$de), 1)) ~ ", " ~
#'                                   sigma == .(round(res$sig, 1)) ~ ", " ~
#'                                   rho == .(round(res$p0, 2))))
#'
#' # (3) Run the minimum age model with bootstrap
#' # NOTE: Bootstrapping is computationally intensive
#' # (3.1) run the minimum age model with default values for bootstrapping
#' calc_MinDose(data = ExampleData.DeValues$CA1,
#'              sigmab = 0.15,
#'              bootstrap = TRUE)
#'
#' # (3.2) Bootstrap control parameters
#' mam <- calc_MinDose(data = ExampleData.DeValues$CA1,
#'                     sigmab = 0.15,
#'                     bootstrap = TRUE,
#'                     bs.M = 300,
#'                     bs.N = 500,
#'                     bs.h = 4,
#'                     sigmab.sd = 0.06,
#'                     plot = FALSE)
#'
#' # Plot the results
#' plot_RLum(mam)
#'
#' # save bootstrap results in a separate variable
#' bs <- get_RLum(mam, "bootstrap")
#'
#' # show structure of the bootstrap results
#' str(bs, max.level = 2, give.attr = FALSE)
#'
#' # print summary of minimum dose and likelihood pairs
#' summary(bs$pairs$gamma)
#'
#' # Show polynomial fits of the bootstrap pairs
#' bs$poly.fits$poly.three
#'
#' # Plot various statistics of the fit using the generic plot() function
#' par(mfcol=c(2,2))
#' plot(bs$poly.fits$poly.three, ask = FALSE)
#'
#' # Show the fitted values of the polynomials
#' summary(bs$poly.fits$poly.three$fitted.values)
#' }
#'
#' @export
calc_MinDose <- function(
  data,
  sigmab,
  log = TRUE,
  par = 3,
  bootstrap = FALSE,
  init.values = NULL,
  level = 0.95,
  log.output = FALSE,
  plot = TRUE,
  multicore = FALSE,
  ...
) {
  .set_function_name("calc_MinDose")
  on.exit(.unset_function_name(), add = TRUE)

  ## Integrity checks -------------------------------------------------------
  .validate_class(data, c("data.frame", "RLum.Results"))
  .validate_not_empty(data)
  if (inherits(data, "RLum.Results")) {
    data <- get_RLum(data, "data")
  }
  if (ncol(data) < 2) {
    .throw_error("'data' should have 2 columns")
  }

  if (!all(stats::complete.cases(data))) {
    .throw_message("Warning: Input data contained NA/NaN values, ",
                   "which were removed prior to calculations", error = FALSE)
    data <- data[stats::complete.cases(data), ]
    if (nrow(data) == 0)
      .throw_error("After NA removal, nothing is left from the data set")
  }

  .validate_positive_scalar(sigmab)
  if (!is.null(init.values)) {
    .validate_class(init.values, "list")
    exp.names <- c("gamma", "sigma", "p0", "mu")
    mis.names <- setdiff(exp.names, names(init.values))
    if (length(init.values) < length(exp.names) || length(mis.names) > 0) {
      .throw_error("Please provide initial values for all model parameters. ",
                   "\nMissing parameters: ",
                   toString(mis.names))
    }
  }

  ## par can only be 3 or 4
  .validate_positive_scalar(par, int = TRUE)
  if (!par %in% c(3, 4)) {
    .throw_error("'par' can only be set to 3 or 4")
  }

  .validate_positive_scalar(level)
  .validate_logical_scalar(log)
  .validate_logical_scalar(bootstrap)
  .validate_logical_scalar(log.output)
  .validate_logical_scalar(plot)
  .validate_logical_scalar(multicore)

  ##============================================================================##
  ## ... ARGUMENTS
  ##============================================================================##

  extraArgs <- list(...)

  ## check if this function is called by calc_MaxDose()
  if ("invert" %in% names(extraArgs)) {
    invert <- .validate_logical_scalar(extraArgs$invert, name = "'invert'")
    if (invert && !log) {
      log <- TRUE # overwrite user choice as max dose model currently only supports the logged version
      .throw_warning("The maximum dose model only supports the logged version, ",
                     "'log' reset to TRUE\n")
    }
  } else {
    invert <- FALSE
  }

  ## console output
  verbose <- extraArgs$verbose %||% TRUE
  .validate_logical_scalar(verbose)

  ## bootstrap replications
  # first level bootstrap
  if ("bs.M" %in% names(extraArgs)) {
    M <- .validate_positive_scalar(as.integer(extraArgs$bs.M),
                                   int = TRUE, name = "'bs.M'")
    M <- max(M, 2) # issue 900
  } else {
    M <- 1000
  }

  # second level bootstrap
  if ("bs.N" %in% names(extraArgs)) {
    N <- .validate_positive_scalar(as.integer(extraArgs$bs.N),
                                   int = TRUE, name= "'bs.N'")
    N <- max(N, 2) # issue 1355
  } else {
    N <- 3*M
  }

  # KDE bandwith
  if ("bs.h" %in% names(extraArgs)) {
    h <- .validate_positive_scalar(extraArgs$bs.h, name = "'bs.h'")
  } else {
    h <- sd(data[, 1]) / sqrt(nrow(data)) * 2
  }

  # standard deviation of sigmab
  if ("sigmab.sd" %in% names(extraArgs)) {
    sigmab.sd <- .validate_positive_scalar(extraArgs$sigmab.sd,
                                           name = "'sigmab.sd'")
  } else {
    sigmab.sd <- 0.04
  }

  if ("debug" %in% names(extraArgs)) {
    debug <- .validate_logical_scalar(extraArgs$debug, name = "'debug'")
  } else {
    debug <- FALSE
  }

  if (multicore && "cores" %in% names(extraArgs)) {
    cores <- .validate_positive_scalar(extraArgs$cores,
                                       int = TRUE, name = "'cores'")
  } else {
    cores <- ifelse(multicore, parallel::detectCores(), 1)
    if (multicore && verbose)
      message("Logical CPU cores detected: ", cores) # nocov
  }

  ## remove non-positive values if using log-transformation
  if (log) {
    nonpos <- data[, 1] <= 0
    if (sum(nonpos) > 0) {
      .throw_warning("De values must be positive with 'log = TRUE', ",
                     sum(nonpos), " values set to NA")
      data[nonpos, 1] <- NA
    }
  }


  ##============================================================================##
  ## START VALUES
  ##============================================================================##

  if (is.null(init.values)) {
    start <- list(gamma = ifelse(log, log(quantile(data[ ,1], probs = 0.25, na.rm = TRUE)),
                                 quantile(data[ ,1], probs = 0.25, na.rm = TRUE)),
                  sigma = 1.2,
                  p0 = 0.01,
                  mu = ifelse(log, log(quantile(data[ ,1], probs = 0.25, na.rm = TRUE)),
                              mean(data[ ,1])))
  } else {
    start <- list(gamma = ifelse(log, log(init.values$gamma), init.values$gamma),
                  sigma = ifelse(log, log(init.values$sigma), init.values$sigma),
                  p0 = init.values$p0,
                  mu = ifelse(log, log(init.values$mu), init.values$mu))
  }

  ##============================================================================##
  ## ESTIMATE BOUNDARY PARAMETERS
  ##============================================================================##

  boundaries <- list(
    # gamma.lower = min(data[ ,1]/10),
    # gamma.upper = max(data[ ,1]*1.1),
    # sigma.lower = 0,
    # sigma.upper = 5,
    # mu.lower = min(data[ ,1])/10,
    # mu.upper = max(data[ ,1]*1.1)
    gamma.lower = -Inf,
    gamma.upper = Inf,

    sigma.lower = 0,
    sigma.upper = Inf,

    p0.lower = 0,
    p0.upper = 1,

    mu.lower = -Inf,
    mu.upper = Inf
  )

  boundaries <- modifyList(boundaries, list(...))

  ##============================================================================##
  ## AUXILIARY FUNCTIONS
  ##============================================================================##

  # THIS FUNCTION CALCULATES THE NEGATIVE LOG LIKELIHOOD OF THE DATA
  Neglik_f <- function(gamma, sigma, p0, mu, data) {
    # this calculates the negative of the log likelihood of the
    # data (data) for a given set of parameters (gamma, sigma, p0)
    # data is a 2x2 matrix of data: De, rel_error (including sigma_b)

    # recover the data
    zi <- data[ ,1]
    si <- data[ ,2]

    # in the MAM-3 gamma and mu are assumed to be equal
    if (par == 3)
      mu <- gamma

    # calculate sigma^2 + seld^2, mu0 and sigma0
    s2 <- sigma^2 + si^2
    sigma0 <- 1/sqrt(1/sigma^2 + 1/si^2)
    mu0 <- (mu/sigma^2 + zi/si^2)/(1/sigma^2 + 1/si^2)

    # calculate the log-likelihood
    logsqrt2pi <- 0.5*log(2*pi)
    res0 <- (gamma - mu0)/sigma0
    res1 <- (gamma - mu)/sigma
    lf1i <- log(p0) - log(si) - 0.5*((zi-gamma)/si)^2   - logsqrt2pi
    lf2i <- log1p(-p0) - 0.5 * log(s2) - 0.5 * (zi - mu)^2 / s2  - logsqrt2pi
    lf2i <- lf2i + log1p(-stats::pnorm(res0)) - log1p(-stats::pnorm(res1))
    llik <- log( exp(lf1i) + exp(lf2i) )

    ## negative log-likelihood
    -sum(llik)
  }

  # THIS MAXIMIZES THE Neglik_f LIKELIHOOD FUNCTION AND RETURNS AN MLE OBJECT
  Get_mle <- function(data) {
    tryCatch({
      suppressWarnings(
        mle <- bbmle::mle2(data = list(data = data),
                           optimizer = "nlminb",
                           lower=c(gamma = boundaries$gamma.lower,
                                   sigma = boundaries$sigma.lower,
                                   p0 = boundaries$p0.lower,
                                   mu = boundaries$mu.lower),
                           upper=c(gamma = boundaries$gamma.upper,
                                   sigma = boundaries$sigma.upper,
                                   p0 = boundaries$p0.upper,
                                   mu = boundaries$mu.upper),
                           minuslogl = Neglik_f,
                           control = list(iter.max = 1000L),
                           start = start)
      )
    }, error = function(e) {
      .throw_error("Maximizing the negative log-likelihood failed: ", e$message) # nocov
    })
    mle
  }

  ## Function to extract the estimate of gamma from mle2 objects and converting
  ## it back to the 'normal' scale
  save_Gamma <- function(ests) {
    m <- bbmle::coef(ests)[["gamma"]]
    if (invert)
      m <- -1 * (m - x.offset)
    if (log)
      m <- exp(m)
    m
  }

  ## Undo the invert transformation on a confidence interval data frame
  undo_invert <- function(conf) {
    conf[1, ] <- (conf[1, ] - x.offset) * -1
    tmp <- conf[1, 1]
    conf[1, 1] <- conf[1,2]
    conf[1, 2] <- tmp
    conf
  }

  ## Collect the parameter estimates from mle2 objects, converting back
  ## log-transformed values to the normal scale
  extract_estimates <- function(ests) {
    res <- data.frame(gamma = save_Gamma(ests),
                      sigma = bbmle::coef(ests)[["sigma"]],
                      p0 = bbmle::coef(ests)[["p0"]],
                      mu = if (par == 4) bbmle::coef(ests)[["mu"]] else NA,
                      row.names = "Estimate", check.names = FALSE)
    if (log) {
      res$sigma <- exp(res$sigma)
      res$mu <- exp(res$mu)
    }

    res
  }

  ##============================================================================##
  ## MAIN PROGRAM
  ##============================================================================##

  ## adds the sigmab error to each individual De error
  combine_Errors <- function(data, err) {
    if (log) {
      lcd  <- log(data[, 1]) * ifelse(invert, -1, 1)
      if (invert) {
        lcd <- lcd + x.offset
      }
      lse <- sqrt((data[, 2] / data[, 1])^2 + err^2)
    } else {
      lcd <- data[, 1]
      lse <- sqrt(data[, 2]^2 + err^2)
    }
    cbind(lcd, lse)
  }

  ## create new data frame with DE and combined relative error
  x.offset <- 0
  dat <- combine_Errors(data, sigmab)

  ## recompute the offset if necessary
  if (log && invert) {
    x.offset <- abs(min(dat[, 1], na.rm = TRUE))
    dat[, 1] <- dat[, 1] + x.offset
  }

  ## remove NAs which may be present if we had non-positive De values with
  ## log = TRUE
  dat <- dat[!is.na(dat[, 1]), ]

  # get the maximum likelihood estimate
  ests <- Get_mle(dat)

  # check if any standard errors are NA or NaN
  coef_err <- suppressWarnings(
    t(as.data.frame(bbmle::summary(ests)@coef[ ,2]))
  )

  if (debug)
    print(suppressWarnings(bbmle::summary(ests)))

  ## deal with NA/NaN values
  if (anyNA(coef_err)) {
    na.idx <- is.na(coef_err)
    coef_err[na.idx] <- t(as.data.frame(ests@coef))[na.idx] / 100
  }

  which <- c("gamma", "sigma", "p0", if (par == 4) "mu")
  prof.lower <- c(gamma = -Inf, sigma = 0, p0 = 0, mu = -Inf)
  prof.upper <- c(gamma = Inf, sigma = Inf, p0 = 1, mu = Inf)

  # calculate profile log likelihoods
  prof <- suppressWarnings(
    bbmle::profile(ests,
                   which = which,
                   std.err = as.vector(coef_err),
                   #try_harder = TRUE,
                   quietly = TRUE,
                   tol.newmin = Inf,
                   skiperrs = TRUE,
                   prof.lower = prof.lower,
                   prof.upper = prof.upper)
  )
  # Fallback when profile() returns a 'better' fit
  maxsteps <- 100
  cnt <- 1
  while (!inherits(prof, "profile.mle2")) {
    if (maxsteps == 0L)
      .throw_error("Couldn't find a converging fit for the profile log-likelihood")
    if (verbose)
      message("## Trying to find a better fit (", cnt, "/10) ##")
    prof <- suppressWarnings(
      bbmle::profile(ests,
                     which = which,
                     std.err = as.vector(coef_err),
                     # try_harder = TRUE,
                     quietly = TRUE,
                     maxsteps = maxsteps,
                     tol.newmin = Inf,
                     skiperrs = TRUE,
                     prof.lower = prof.lower,
                     prof.upper = prof.upper)
    )
    maxsteps <- maxsteps - 10
    cnt <- cnt + 1
  }

  ## delete rows where z = -Inf/Inf or NaN
  prof@profile$gamma <- prof@profile$gamma[is.finite(prof@profile$gamma$z), ]
  prof@profile$sigma <- prof@profile$sigma[is.finite(prof@profile$sigma$z), ]
  prof@profile$p0 <- prof@profile$p0[is.finite(prof@profile$p0$z), ]
  if (par == 4) {
    prof@profile$mu <- prof@profile$mu[is.finite(prof@profile$mu$z), ]
  }

  ## calculate Bayesian Information Criterion (BIC)
  BIC <- BIC(ests)
  Lmax <- -ests@min

  ##============================================================================##
  ## ERROR CALCULATION

  #### METHOD 1: follow the instructions of Galbraith & Roberts (2012) ####
  # "If the likelihood profile is symmetrical about the parameter, an approximate standard error
  #  can be calculated by dividing the length of this interval by 3.92"
  conf <- suppressWarnings(
    as.data.frame(bbmle::confint(prof, tol.newmin = Inf, quietly = TRUE, level = level))
  )
  class(conf[,1]) <- class(conf[,2]) <- "numeric"

  if (invert) {
    conf <- undo_invert(conf)
  }

  ## keep a copy of the original conf object to be returned at the end
  conf.orig <- conf
  if (log) {
    logged.rows <- row.names(conf) != "p0"
    conf[logged.rows, ] <- exp(conf[logged.rows, ])
  }

  gamma_err <- (conf["gamma", 2] - conf["gamma", 1]) / 3.92

  ## retrieve results from mle2 object
  res <- extract_estimates(ests)

  ##============================================================================##
  ## BOOTSTRAP
  ##============================================================================##
  if (bootstrap) {

    # Function that produces N+M replicates from the original data set using
    # randomly sampled indices with replacement and adding a randomly drawn
    # sigmab error
    create_Replicates <- function(R, e) {
      d <- apply(R, 1, function(x) data[x, ])
      mapply(function(x, y) combine_Errors(x, y), d, e, SIMPLIFY = FALSE)
    }

    # Function that takes each of the N replicates and produces a kernel density
    # estimate of length n.
    get_KDE <- function(d) {
      f <- approx(density(x = d[, 1], kernel = "gaussian", bw = h, na.rm = TRUE),
                  xout = d[, 1])
      pStarTheta <- as.vector(f$y / sum(f$y))
      pStarTheta / (1 / n)
    }

    # Function that calculates the product term of the recycled bootstrap
    get_ProductTerm <- function(Pmat, freq) {
      apply(Pmat^freq, 1, prod)
    }

    # Function that calculates the pseudo likelihoods for M replicates and
    # returns the dose-likelihood pairs
    make_Pairs <- function(theta, b2mam, prodterm) {
      kdthis <- vapply(theta, function(x) (x - b2mam) / h, numeric(N))
      kd1 <- dnorm(kdthis)
      kd2 <- kd1 * prodterm
      kd <- colSums(kd2, na.rm = TRUE)
      likelihood <- kd / (N * h)
      cbind(theta, likelihood)
    }

    ## Function to produce smoothed polynomial fits
    ## USS: unshared systematic error (3.5% in the paper)
    # nocov start
    get_polyfit <- function(pairs, degree, USS = 0.035) {
      x <- pairs[, 1]
      pairs[, 1] <- suppressWarnings(rnorm(length(x), mean = x, sd = USS * x))
      pairs_sorted <- pairs[order(pairs[, 1]), ]
      x <- pairs_sorted[, 1]
      y <- pairs_sorted[, 2]

      ## remove non-positive values as we are applying the log
      ypos <- y > 0
      x <- x[ypos]
      y <- y[ypos]

      ## fit polynomial to log(y), then exponentiate back
      fit <- stats::lm(log(y) ~ poly(x, degree, raw = TRUE), na.action = na.exclude)
      f <- exp(predict(fit, newdata = data.frame(x)))

      ## vector of points to interpolate fit
      xi <- seq(min(x, na.rm = TRUE), max(x, na.rm = TRUE), length.out = 100)
      yi <- approx(x, f, xout = xi)$y

      ind1 <- which(yi > 0)
      yi[!is.finite(yi)] <- 0

      list(xycurve = cbind(xi[min(ind1):max(ind1)],
                           yi[min(ind1):max(ind1)]),
           pairsUSS = pairs,
           fit = fit)
    }
    # nocov end

    ## START BOOTSTRAP ----
    msg <- sprintf(paste("\n [calc_MinDose] \n\nRecycled Bootstrap",
                         "\n\nParameters:",
                         "\n M = %d",
                         "\n N = %d",
                         "\n sigmab = %.2f \U00B1 %.2f",
                         "\n h = %.2f",
                         "\n\nCreating %d bootstrap replicates..."),
                   M, N, sigmab, sigmab.sd, h, N+M)
    if (verbose)
      message(msg)

    n <- length(data[ ,1])
    # Draw N+M samples from a normally distributed sigmab
    sigmab.bs <- rnorm(N + M, sigmab, sigmab.sd)

    ## Draw N+M random indices of size n
    indices <- matrix(sample(n, size = n * (N + M), replace = TRUE),
                      nrow = N + M, ncol = n, byrow = TRUE)

    # Finally draw N+M bootstrap replicates
    replicates <- create_Replicates(indices, sigmab.bs)

    # MULTICORE: The call to 'Get_mle' is the bottleneck of the function.
    # Using multiple CPU cores can reduce the computation cost, but may
    # not work for all machines.
    if (verbose) {
      message("Applying the model to all replicates using ", cores,
              " cores, this may take a while...")
    }

    if (multicore) {
      cl <- parallel::makeCluster(cores)
      mle <- parallel::parLapply(cl, replicates, Get_mle)
      parallel::stopCluster(cl)
    } else {
      mle <- lapply(replicates, Get_mle)
    }

    # Final bootstrap calculations
    if (verbose)
      message("Calculating likelihoods...")
    # Save 2nd- and 1st-level bootstrap results (i.e. estimates of gamma)
    b2mam <- sapply(mle[1:N], save_Gamma)
    theta <- sapply(mle[c(N+1):c(N+M)], save_Gamma)

    # Calculate the probability/pseudo-likelihood
    Pmat <- lapply(replicates[c(N+1):c(N+M)], get_KDE)
    freq <- t(apply(indices[1:N, ], 1, tabulate, n))
    prodterm <- vapply(Pmat, get_ProductTerm, freq, FUN.VALUE = numeric(N))

    # Save the bootstrap results as dose-likelihood pairs
    pairs <- make_Pairs(theta, b2mam, prodterm)

    ## --------- FIT POLYNOMIALS -------------- ##
    if (verbose)
      message("Fitting curves to dose-likelihood pairs...")
    # polynomial fits of increasing degrees

    ## if the input values are too close to zero, we may get
    ## Inf values >>> we remove them here with a warning
    is.inf <- is.infinite(pairs[, 2])
    if (any(is.inf)) {
      # nocov start
      .throw_warning("Inf values produced by bootstrapping removed for loess ",
                     "fitting (", round(sum(is.inf) / nrow(pairs) * 100, 2),
                     "% of the total dataset). This message usually indicates ",
                     "that your values are close to 0.")
      pairs <- pairs[!is.inf, ]
      # nocov end
    }

    poly.three <- stats::lm(pairs[, 2] ~ poly(pairs[, 1], degree = 3, raw = TRUE))
    poly.four <- stats::lm(pairs[, 2] ~ poly(pairs[, 1], degree = 4, raw = TRUE))
    poly.five <- stats::lm(pairs[, 2] ~ poly(pairs[, 1], degree = 5, raw = TRUE))
    poly.six <- stats::lm(pairs[, 2] ~ poly(pairs[, 1], degree = 6, raw = TRUE))

    ## --------- FIT LOESS -------------- ##
    # Polynomials are probably not reasonable and often suffer badly from
    # overfitting, especially towards the margins of the fitted data. In this
    # particular use case polynomials may suggest a multimodal likelihood
    # distribution where actually none is given. The non-parametric
    # LOESS (LOcal polynomial regrESSion) often yields better results than
    # standard polynomials.
    if (length(unique(pairs[, 1])) >= 15) {
      loess <- loess(pairs[, 2] ~ pairs[, 1])
    } else {
      loess <- NA
      .throw_warning("Not enough bootstrap replicates for loess fitting, try ",
                     "increasing `bs.M`")
    }

    ## extract the parameters from the bootstrap replicates
    mle <- rbindlist(lapply(mle[N + 1:M], extract_estimates))

    ## compute the mean of each parameter
    res <- data.frame(apply(mle, 2, mean, simplify = FALSE))
    rownames(res) <- "Estimate"

    ## quantiles from the bootstrap replicates
    prob <- (1 + c(-level, level)) / 2
    conf <- data.frame(t(apply(mle[, 1:par], 2, quantile,
                               na.rm = TRUE, probs = prob)))
    colnames(conf) <- paste(prob * 100, "%")

    ## keep a copy of the conf object in the scale in which the models were
    ## fitted
    conf.orig <- conf
    if (log) {
      logged.rows <- row.names(conf.orig) != "p0"
      conf.orig[logged.rows, ] <- log(conf.orig[logged.rows, ])
    }

    ## standard deviation over the De values from the bootstrap replicates
    gamma_err <- sd(pairs[, "theta"])

  }#EndOf::Bootstrap

  ## ========================================================================
  ## AGGREGATE RESULTS

  summary <- data.frame(de = res$gamma,
                        de_err = gamma_err,
                        ci_level = level,
                        ci_lower = conf["gamma", 1],
                        ci_upper = conf["gamma", 2],
                        par = par,
                        sig = res$sigma,
                        p0 = res$p0,
                        mu = res$mu,
                        Lmax = Lmax,
                        BIC = BIC)
  call <- sys.call()
  args <- list(log = log, sigmab = sigmab, par = par, bootstrap = bootstrap,
               init.values = start, log.output = log.output,
               bs.M = M, bs.N = N, bs.h = h, sigmab.sd = sigmab.sd)

  if (!is.na(summary$mu) && !is.na(summary$de) &&
    ## equivalent to log(summary$de) > summary$mu, but also valid if de < 0
    summary$de > exp(summary$mu)) {
      .throw_warning("Gamma is larger than mu, consider running the model ",
                     "with new boundary values (see details '?calc_MinDose')")
  }

  ##============================================================================##
  ## CONSOLE PRINT
  ##============================================================================##

  if (verbose) {
    cat("\n----------- Meta data -----------\n")
    print(data.frame(n = length(data[, 1]),
                       par=par,
                       sigmab=sigmab,
                       logged=log,
                       Lmax = Lmax,
                       BIC=BIC,
                       row.names = ""))

    cat(sprintf("\n--- Final parameter estimates%s ---\n",
                ifelse(bootstrap, " (bootstrap)", "")))
    if (log && log.output) {
      res$`log(gamma)` <- log(res$gamma)
      res$`log(sigma)` <- log(res$sigma)
      res$`log(mu)` <- log(res$mu)
    }
    print(round(res[, 1:par], 2))

    cat(sprintf("\n------ Confidence intervals%s -----\n",
                ifelse(bootstrap, " (bootstrap)", "")))
    conf_print <- conf
    conf_print <- round(conf_print, 2)

    if (log && log.output) {
      logged.rows <- row.names(conf) != "p0"
      conf_log <- conf
      conf_log[logged.rows, ] <- log(conf_log[logged.rows, ])

      conf_log <- round(conf_log, 2)
      conf_log[which(rownames(conf_log) == "p0"), ] <- "-"
      conf_print <- cbind(conf_print, conf_log)
      ncols <- ncol(conf_print) / 2
      conf_print <- rbind(setNames(data.frame(as.list(rep("", ncols)),
                                              as.list(rep("(logged)", ncols)),
                                              row.names = ""),
                                   colnames(conf_print)),
                          conf_print)
    }

    print(conf_print)

    cat(sprintf("\n------ De (asymmetric error)%s -----\n",
                ifelse(bootstrap, " (bootstrap)", "")))
    print(round(data.frame(De = summary$de,
                           lower = conf["gamma", 1],
                           upper = conf["gamma", 2],
                           row.names = ""), 2))

    cat(sprintf("\n------ De (symmetric error)%s -----\n",
                ifelse(bootstrap, " (bootstrap)", "")))
    print(round(data.frame(De = summary$de,
                           error = gamma_err,
                           row.names = ""), 2))
  }

  ##============================================================================##
  ## RETURN VALUES
  ##============================================================================##

  if (invert)
    prof@profile$gamma$par.vals[ ,"gamma"] <- rev((prof@profile$gamma$par.vals[ ,"gamma"] - x.offset)*-1)

  if (!bootstrap)
    pairs <- poly.three <- poly.four <- poly.five <- poly.six <- loess <- NULL

  results <- set_RLum(
    class = "RLum.Results",
    originator = "calc_MinDose",
    data = list(summary = summary,
                data = data,
                args = args,
                call = call,
                mle = ests,
                BIC = BIC,
                confint = conf.orig,
                profile = prof,
                bootstrap = list(
                  pairs = list(gamma=pairs),
                  poly.fits = list(poly.three = poly.three,
                                   poly.four = poly.four,
                                   poly.five = poly.five,
                                   poly.six = poly.six),
                  loess.fit = loess)))

  ##=========##
  ## PLOTTING
  if (plot) {
    try(plot_RLum.Results(results, ...),
        outFile = stdout()) # redirect error messages so they can be silenced
  }

  results
}
