diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2022-08-14 14:57:13 +0200 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-08-14 14:57:13 +0200 |
commit | eb8b56ed6f83e3c7df63e48f9488362363d26709 (patch) | |
tree | 14e1fba1bd096d8d5adf2f3e7c1d5e4e53187401 /R/parms.mkinfit.R | |
parent | 118b3753740ff4e7dc777baac7e769950005697b (diff) |
Basic multistart method for saem.mmkin objects
Diffstat (limited to 'R/parms.mkinfit.R')
-rw-r--r-- | R/parms.mkinfit.R | 30 |
1 files changed, 19 insertions, 11 deletions
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) } |