diff options
| author | Johannes Ranke <jranke@uni-bremen.de> | 2022-08-31 17:15:59 +0200 | 
|---|---|---|
| committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-08-31 17:15:59 +0200 | 
| commit | cba325aa66d36e210499b42a9761e3e90fc3d5fe (patch) | |
| tree | 540a6a0398e98b8bd5992f0dade482350caa4b27 | |
| parent | eb8b56ed6f83e3c7df63e48f9488362363d26709 (diff) | |
Some more work on multistart
| -rw-r--r-- | R/multistart.R | 17 | ||||
| -rw-r--r-- | R/saem.R | 21 | 
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 +} @@ -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) +} | 
