Basic multistart method for saem.mmkin objects

6 files changed, 99 insertions, 23 deletions

diff --git a/NAMESPACE b/NAMESPACE
index 50cf1486..39588dea 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -27,6 +27,7 @@ S3method(mhmkin,list)
 S3method(mixed,mmkin)
 S3method(mkinpredict,mkinfit)
 S3method(mkinpredict,mkinmod)
+S3method(multistart,saem.mmkin)
 S3method(nlme,mmkin)
 S3method(nobs,mkinfit)
 S3method(parms,mkinfit)
@@ -106,6 +107,7 @@ export(mkinpredict)
 export(mkinresplot)
 export(mkinsub)
 export(mmkin)
+export(multistart)
 export(nafta)
 export(nlme)
 export(nlme_data)
diff --git a/R/multistart.R b/R/multistart.R
index db482cc4..819fcc1b 100644
--- a/R/multistart.R
+++ b/R/multistart.R
@@ -7,18 +7,38 @@
 #' inspired by the article on practical identifiabiliy in the frame of nonlinear
 #' mixed-effects models by Duchesne et al (2021).
 #'
+#' Currently, parallel execution of the fits is only supported using
+#' [parallel::mclapply], i.e. not available on Windows.
+#'
+#' @param object The fit object to work with
+#' @param n How many different combinations of starting parameters should be
+#' used?
+#' @param cores How many fits should be run in parallel?
+#' @param \dots Passed to the update function.
+#' @return A list of [saem.mmkin] objects, with class attributes
+#' 'multistart.saem.mmkin' and 'multistart'.
+#'
 #' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical
 #' identifiability in the frame of nonlinear mixed effects models: the example
 #' of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.
 #' doi: 10.1186/s12859-021-04373-4.
 #' @export
-multistart <- function(object, n = 50, ...)
+multistart <- function(object, n = 50, cores = 1, ...)
 {
   UseMethod("multistart", object)
 }
 
 #' @rdname multistart
 #' @export
-multistart.saem.mmkin <- function(object, n = 50, ...) {
-  
+multistart.saem.mmkin <- function(object, n = 50, cores = 1, ...) {
+  start_parms <- apply(
+    parms(object$mmkin, errparms = FALSE), 1,
+      function(x) stats::runif(n, min(x), max(x))
+  )
+
+  res <- parallel::mclapply(1:n, function(x) {
+    update(object, degparms_start = start_parms[x], ...)
+  }, mc.cores = cores)
+  class(res) <- c("multistart.saem.mmkin", "multistart")
+  return(res)
 }
diff --git a/R/parms.mkinfit.R b/R/parms.mkinfit.R
index a1f2d209..31ca05bc 100644
--- a/R/parms.mkinfit.R
+++ b/R/parms.mkinfit.R
@@ -8,9 +8,9 @@
 #'  [mkinfit()] objects and for [mmkin()] objects.
 #' @param \dots Not used
 #' @return For mkinfit objects, a numeric vector of fitted model parameters.
-#'  For mmkin row objects, a matrix with the parameters with a
-#'  row for each dataset. If the mmkin object has more than one row, a list of
-#'  such matrices is returned.
+#' For mmkin row objects, a matrix with the parameters with a row for each
+#' dataset. If the mmkin object has more than one row, a list of such matrices
+#' is returned.
 #' @examples
 #' # mkinfit objects
 #' fit <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)
@@ -34,27 +34,35 @@ parms <- function(object, ...)
   UseMethod("parms", object)
 }
 
-#' @param transformed Should the parameters be returned
-#'   as used internally during the optimisation?
+#' @param transformed Should the parameters be returned as used internally
+#' during the optimisation?
+#' @param errparms Should the error model parameters be returned
+#' in addition to the degradation parameters?
 #' @rdname parms
 #' @export
-parms.mkinfit <- function(object, transformed = FALSE, ...)
+parms.mkinfit <- function(object, transformed = FALSE, errparms = TRUE, ...)
 {
-  if (transformed) object$par
-  else c(object$bparms.optim, object$errparms)
+  res <- if (transformed) object$par
+    else c(object$bparms.optim, object$errparms)
+  if (!errparms) {
+    res[setdiff(names(res), names(object$errparms))]
+  }
+  else return(res)
 }
 
 #' @rdname parms
 #' @export
-parms.mmkin <- function(object, transformed = FALSE, ...)
+parms.mmkin <- function(object, transformed = FALSE, errparms = TRUE, ...)
 {
   if (nrow(object) == 1) {
-    res <- sapply(object, parms, transformed = transformed, ...)
+    res <- sapply(object, parms, transformed = transformed,
+      errparms = errparms, ...)
     colnames(res) <- colnames(object)
   } else {
     res <- list()
     for (i in 1:nrow(object)) {
-      res[[i]] <- parms(object[i, ], transformed = transformed, ...)
+      res[[i]] <- parms(object[i, ], transformed = transformed,
+        errparms = errparms, ...)
     }
     names(res) <- rownames(object)
   }
diff --git a/man/mkinfit.Rd b/man/mkinfit.Rd
index f96b4d22..b5b24449 100644
--- a/man/mkinfit.Rd
+++ b/man/mkinfit.Rd
@@ -23,8 +23,8 @@ mkinfit(
   atol = 1e-08,
   rtol = 1e-10,
   error_model = c("const", "obs", "tc"),
-  error_model_algorithm = c("auto", "d_3", "direct", "twostep", "threestep", "fourstep",
-    "IRLS", "OLS"),
+  error_model_algorithm = c("auto", "d_3", "direct", "twostep", "threestep",
+    "fourstep", "IRLS", "OLS"),
   reweight.tol = 1e-08,
   reweight.max.iter = 10,
   trace_parms = FALSE,
diff --git a/man/multistart.Rd b/man/multistart.Rd
new file mode 100644
index 00000000..ff60b01d
--- /dev/null
+++ b/man/multistart.Rd
@@ -0,0 +1,43 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/multistart.R
+\name{multistart}
+\alias{multistart}
+\alias{multistart.saem.mmkin}
+\title{Perform a hierarchical model fit with multiple starting values}
+\usage{
+multistart(object, n = 50, cores = 1, ...)
+
+\method{multistart}{saem.mmkin}(object, n = 50, cores = 1, ...)
+}
+\arguments{
+\item{object}{The fit object to work with}
+
+\item{n}{How many different combinations of starting parameters should be
+used?}
+
+\item{cores}{How many fits should be run in parallel?}
+
+\item{\dots}{Passed to the update function.}
+}
+\value{
+A list of \link{saem.mmkin} objects, with class attributes
+'multistart.saem.mmkin' and 'multistart'.
+}
+\description{
+The purpose of this method is to check if a certain algorithm for fitting
+nonlinear hierarchical models (also known as nonlinear mixed-effects models)
+will reliably yield results that are sufficiently similar to each other, if
+started with a certain range of reasonable starting parameters. It is
+inspired by the article on practical identifiabiliy in the frame of nonlinear
+mixed-effects models by Duchesne et al (2021).
+}
+\details{
+Currently, parallel execution of the fits is only supported using
+\link[parallel:mclapply]{parallel::mclapply}, i.e. not available on Windows.
+}
+\references{
+Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical
+identifiability in the frame of nonlinear mixed effects models: the example
+of the in vitro erythropoiesis. BMC Bioinformatics. 2021 Oct 4;22(1):478.
+doi: 10.1186/s12859-021-04373-4.
+}
diff --git a/man/parms.Rd b/man/parms.Rd
index af92bd2a..293bdaab 100644
--- a/man/parms.Rd
+++ b/man/parms.Rd
@@ -8,9 +8,9 @@
 \usage{
 parms(object, ...)
 
-\method{parms}{mkinfit}(object, transformed = FALSE, ...)
+\method{parms}{mkinfit}(object, transformed = FALSE, errparms = TRUE, ...)
 
-\method{parms}{mmkin}(object, transformed = FALSE, ...)
+\method{parms}{mmkin}(object, transformed = FALSE, errparms = TRUE, ...)
 }
 \arguments{
 \item{object}{A fitted model object. Methods are implemented for
@@ -18,14 +18,17 @@ parms(object, ...)
 
 \item{\dots}{Not used}
 
-\item{transformed}{Should the parameters be returned
-as used internally during the optimisation?}
+\item{transformed}{Should the parameters be returned as used internally
+during the optimisation?}
+
+\item{errparms}{Should the error model parameters be returned
+in addition to the degradation parameters?}
 }
 \value{
 For mkinfit objects, a numeric vector of fitted model parameters.
-For mmkin row objects, a matrix with the parameters with a
-row for each dataset. If the mmkin object has more than one row, a list of
-such matrices is returned.
+For mmkin row objects, a matrix with the parameters with a row for each
+dataset. If the mmkin object has more than one row, a list of such matrices
+is returned.
 }
 \description{
 This function always returns degradation model parameters as well as error