aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-13 03:51:22 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-14 14:46:18 +0200
commitb76e401a854021eaeda6f8ba262baf37b4ecfac2 (patch)
treeb3c80276c320080c239eb8508e86c9e06b526143 /R
parent37bd36fe8a75163cbf0f97cb7a0e2f7466a53617 (diff)
Select best fit from multistart, use in parhist
- Add 'best' and 'which.best' generics with methods for multistart objects - Per default, scale the parameters in parhist plots using the fit with the highest log likelihood.
Diffstat (limited to 'R')
-rw-r--r--R/multistart.R40
-rw-r--r--R/parhist.R42
2 files changed, 68 insertions, 14 deletions
diff --git a/R/multistart.R b/R/multistart.R
index b65c0bee..a788953e 100644
--- a/R/multistart.R
+++ b/R/multistart.R
@@ -47,8 +47,10 @@
#' f_saem_full <- saem(f_mmkin)
#' f_saem_full_multi <- multistart(f_saem_full, n = 16, cores = 16)
#' parhist(f_saem_full_multi, lpos = "bottomright")
+#' illparms(f_saem_full)
#'
-#' f_saem_reduced <- update(f_saem_full, covariance.model = diag(c(1, 1, 0, 1)))
+#' f_saem_reduced <- update(f_saem_full, no_random_effect = "log_k2")
+#' illparms(f_saem_reduced)
#' # On Windows, we need to create a cluster first. When working with
#' # such a cluster, we need to export the mmkin object to the cluster
#' # nodes, as it is referred to when updating the saem object on the nodes.
@@ -140,3 +142,39 @@ print.multistart <- function(x, ...) {
cat("<multistart> object with", length(x), "fits:\n")
print(convergence(x))
}
+
+#' @rdname multistart
+#' @export
+best <- function(object, ...)
+{
+ UseMethod("best", object)
+}
+
+#' @export
+#' @return The object with the highest likelihood
+#' @rdname multistart
+best.default <- function(object, ...)
+{
+ return(object[[which.best(object)]])
+}
+
+#' @return The index of the object with the highest likelihood
+#' @rdname multistart
+#' @export
+which.best <- function(object, ...)
+{
+ UseMethod("which.best", object)
+}
+
+#' @rdname multistart
+#' @export
+which.best.default <- function(object, ...)
+{
+ llfunc <- function(object) {
+ ret <- try(logLik(object))
+ if (inherits(ret, "try-error")) return(NA)
+ else return(ret)
+ }
+ ll <- sapply(object, llfunc)
+ return(which.max(ll))
+}
diff --git a/R/parhist.R b/R/parhist.R
index 10730873..5d498664 100644
--- a/R/parhist.R
+++ b/R/parhist.R
@@ -1,12 +1,15 @@
#' Plot parameter distributions from multistart objects
#'
-#' Produces a boxplot with all parameters from the multiple runs, divided by
-#' using their medians as in the paper by Duchesne et al. (2021).
+#' Produces a boxplot with all parameters from the multiple runs, scaled
+#' either by the parameters of the run with the highest likelihood,
+#' or by their medians as proposed in the paper by Duchesne et al. (2021).
#'
#' @param object The [multistart] object
-#' @param \dots Passed to [boxplot]
+#' @param scale By default, scale parameters using the best available fit.
+#' If 'median', parameters are scaled using the median parameters from all fits.
#' @param main Title of the plot
#' @param lpos Positioning of the legend.
+#' @param \dots Passed to [boxplot]
#' @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.
@@ -14,7 +17,9 @@
#' @seealso [multistart]
#' @importFrom stats median
#' @export
-parhist <- function(object, lpos = "bottomleft", main = "", ...) {
+parhist <- function(object, scale = c("best", "median"),
+ lpos = "bottomleft", main = "", ...)
+{
oldpar <- par(no.readonly = TRUE)
on.exit(par(oldpar, no.readonly = TRUE))
@@ -48,23 +53,34 @@ parhist <- function(object, lpos = "bottomleft", main = "", ...) {
colnames(all_parms)[1:length(degparm_names)] <- degparm_names
}
- median_parms <- apply(all_parms, 2, median)
- start_scaled_parms <- rep(NA_real_, length(orig_parms))
- names(start_scaled_parms) <- names(orig_parms)
+ scale <- match.arg(scale)
+ parm_scale <- switch(scale,
+ best = all_parms[which.best(object), ],
+ median = apply(all_parms, 2, median)
+ )
- orig_scaled_parms <- orig_parms / median_parms
- all_scaled_parms <- t(apply(all_parms, 1, function(x) x / median_parms))
- start_scaled_parms[names(start_parms)] <-
- start_parms / median_parms[names(start_parms)]
+ # Boxplots of all scaled parameters
+ all_scaled_parms <- t(apply(all_parms, 1, function(x) x / parm_scale))
boxplot(all_scaled_parms, log = "y", main = main, ,
ylab = "Normalised parameters", ...)
- points(orig_scaled_parms, col = 2, cex = 2)
+ # Show starting parameters
+ start_scaled_parms <- rep(NA_real_, length(orig_parms))
+ names(start_scaled_parms) <- names(orig_parms)
+ start_scaled_parms[names(start_parms)] <-
+ start_parms / parm_scale[names(start_parms)]
points(start_scaled_parms, col = 3, cex = 3)
+
+ # Show parameters of original run
+ orig_scaled_parms <- orig_parms / parm_scale
+ points(orig_scaled_parms, col = 2, cex = 2)
+
+ abline(h = 1, lty = 2)
+
legend(lpos, inset = c(0.05, 0.05), bty = "n",
pch = 1, col = 3:1, lty = c(NA, NA, 1),
legend = c(
"Starting parameters",
- "Converged parameters",
+ "Original run",
"Multistart runs"))
}

Contact - Imprint