aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-08-31 17:15:59 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-08-31 17:15:59 +0200
commitcba325aa66d36e210499b42a9761e3e90fc3d5fe (patch)
tree540a6a0398e98b8bd5992f0dade482350caa4b27
parenteb8b56ed6f83e3c7df63e48f9488362363d26709 (diff)
Some more work on multistart
-rw-r--r--R/multistart.R17
-rw-r--r--R/saem.R21
2 files changed, 33 insertions, 5 deletions
diff --git a/R/multistart.R b/R/multistart.R
index 819fcc1b..fb31d002 100644
--- a/R/multistart.R
+++ b/R/multistart.R
@@ -37,8 +37,23 @@ multistart.saem.mmkin <- function(object, n = 50, cores = 1, ...) {
)
res <- parallel::mclapply(1:n, function(x) {
- update(object, degparms_start = start_parms[x], ...)
+ update(object, degparms_start = start_parms[x, ], ...)
}, mc.cores = cores)
class(res) <- c("multistart.saem.mmkin", "multistart")
return(res)
}
+
+#' @rdname multistart
+#' @export
+print.multistart <- function(x, ...) {
+ cat("Multistart object with", length(x), "fits of the following type:\n\n")
+ print(x[[1]])
+}
+
+#' @rdname multistart
+#' @export
+summary.multistart.saem.mmkin <- function(object) {
+
+ parm_matrix <- sapply(object, parms)
+ parm_matrix
+}
diff --git a/R/saem.R b/R/saem.R
index 370de3d8..6ed3efdd 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -230,10 +230,8 @@ print.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {
row.names = " "), digits = digits)
cat("\nFitted parameters:\n")
- conf.int <- x$so@results@conf.int[c("estimate", "lower", "upper")]
- rownames(conf.int) <- x$so@results@conf.int[["name"]]
- conf.int.var <- grepl("^Var\\.", rownames(conf.int))
- print(conf.int[!conf.int.var, ], digits = digits)
+ conf.int <- parms(x, ci = TRUE)
+ print(conf.int, digits = digits)
invisible(x)
}
@@ -613,3 +611,18 @@ update.saem.mmkin <- function(object, ..., evaluate = TRUE) {
if(evaluate) eval(call, parent.frame())
else call
}
+
+#' @export
+#' @rdname saem
+#' @param ci Should a matrix with estimates and confidence interval boundaries
+#' be returned? If FALSE (default), a vector of estimates is returned.
+parms.saem.mmkin <- function(x, ci = FALSE, ...) {
+ conf.int <- x$so@results@conf.int[c("estimate", "lower", "upper")]
+ rownames(conf.int) <- x$so@results@conf.int[["name"]]
+ conf.int.var <- grepl("^Var\\.", rownames(conf.int))
+ conf.int <- conf.int[!conf.int.var, ]
+ estimate <- conf.int[, "estimate"]
+ names(estimate) <- rownames(conf.int)
+ if (ci) return(conf.int)
+ else return(estimate)
+}

Contact - Imprint