aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-28 13:39:15 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-28 13:39:15 +0200
commitf820bf5b91be0f589de16c3e3250f5f79672df75 (patch)
tree2b1406e1c9286634ca017db586e09e2299dec048 /R
parentb1740ade9a1746ccdb325b95915ef88872489f03 (diff)
Rename parhist to parplot and make it generic
That parhist name was not the brightest idea, as it does not show histograms.
Diffstat (limited to 'R')
-rw-r--r--R/llhist.R3
-rw-r--r--R/multistart.R6
-rw-r--r--R/parplot.R (renamed from R/parhist.R)12
-rw-r--r--R/saem.R2
4 files changed, 15 insertions, 8 deletions
diff --git a/R/llhist.R b/R/llhist.R
index 22e3aa08..e158495d 100644
--- a/R/llhist.R
+++ b/R/llhist.R
@@ -25,6 +25,7 @@ llhist <- function(object, breaks = "Sturges", lpos = "topleft", main = "",
stop("llhist is only implemented for multistart.saem.mmkin objects")
}
+ ll_orig <- logLik(attr(object, "orig"))
ll <- stats::na.omit(sapply(object, llfunc))
par(las = 1)
@@ -34,7 +35,7 @@ llhist <- function(object, breaks = "Sturges", lpos = "topleft", main = "",
freq_factor <- h$counts[1] / h$density[1]
- abline(v = logLik(attr(object, "orig")), col = 2)
+ abline(v = ll_orig, col = 2)
legend(lpos, inset = c(0.05, 0.05), bty = "n",
lty = 1, col = c(2),
diff --git a/R/multistart.R b/R/multistart.R
index 29ccdc44..14683c11 100644
--- a/R/multistart.R
+++ b/R/multistart.R
@@ -17,7 +17,7 @@
#' @param x The multistart object to print
#' @return A list of [saem.mmkin] objects, with class attributes
#' 'multistart.saem.mmkin' and 'multistart'.
-#' @seealso [parhist], [llhist]
+#' @seealso [parplot], [llhist]
#'
#' @references Duchesne R, Guillemin A, Gandrillon O, Crauste F. Practical
#' identifiability in the frame of nonlinear mixed effects models: the example
@@ -40,7 +40,7 @@
#' f_mmkin <- mmkin("DFOP", dmta_ds, error_model = "tc", cores = 7, quiet = TRUE)
#' f_saem_full <- saem(f_mmkin)
#' f_saem_full_multi <- multistart(f_saem_full, n = 16, cores = 16)
-#' parhist(f_saem_full_multi, lpos = "bottomleft")
+#' parplot(f_saem_full_multi, lpos = "bottomleft")
#' illparms(f_saem_full)
#'
#' f_saem_reduced <- update(f_saem_full, no_random_effect = "log_k2")
@@ -52,7 +52,7 @@
#' cl <- makePSOCKcluster(12)
#' clusterExport(cl, "f_mmkin")
#' f_saem_reduced_multi <- multistart(f_saem_reduced, n = 16, cluster = cl)
-#' parhist(f_saem_reduced_multi, lpos = "topright")
+#' parplot(f_saem_reduced_multi, lpos = "topright")
#' }
multistart <- function(object, n = 50,
cores = if (Sys.info()["sysname"] == "Windows") 1 else parallel::detectCores(),
diff --git a/R/parhist.R b/R/parplot.R
index 0f9c9964..627a4eb8 100644
--- a/R/parhist.R
+++ b/R/parplot.R
@@ -1,4 +1,4 @@
-#' Plot parameter distributions from multistart objects
+#' Plot parameter variability of multistart objects
#'
#' Produces a boxplot with all parameters from the multiple runs, scaled
#' either by the parameters of the run with the highest likelihood,
@@ -18,7 +18,13 @@
#' @seealso [multistart]
#' @importFrom stats median
#' @export
-parhist <- function(object, llmin = -Inf, scale = c("best", "median"),
+parplot <- function(object, ...) {
+ UseMethod("parplot")
+}
+
+#' @rdname parplot
+#' @export
+parplot.multistart.saem.mmkin <- function(object, llmin = -Inf, scale = c("best", "median"),
lpos = "bottomleft", main = "", ...)
{
oldpar <- par(no.readonly = TRUE)
@@ -35,7 +41,7 @@ parhist <- function(object, llmin = -Inf, scale = c("best", "median"),
else return(logLik(object$so))
}
} else {
- stop("parhist is only implemented for multistart.saem.mmkin objects")
+ stop("parplot is only implemented for multistart.saem.mmkin objects")
}
ll <- sapply(object, llfunc)
selected <- which(ll > llmin)
diff --git a/R/saem.R b/R/saem.R
index cf67b8e1..090ed3bf 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -726,7 +726,7 @@ saemix_data <- function(object, covariates = NULL, verbose = FALSE, ...) {
#' @param \dots Passed to [saemix::logLik.SaemixObject]
#' @param method Passed to [saemix::logLik.SaemixObject]
#' @export
-logLik.saem.mmkin <- function(object, ..., method = c("lin", "is", "gq")) {
+logLik.saem.mmkin <- function(object, ..., method = c("is", "lin", "gq")) {
method <- match.arg(method)
return(logLik(object$so, method = method))
}

Contact - Imprint