jranke / mkin
1
#' Extract model parameters from mkinfit models
2
#'
3
#' This function always returns degradation model parameters as well as error
4
#' model parameters, in order to avoid working with a fitted model without
5
#' considering the error structure that was assumed for the fit.
6
#'
7
#' @param object A fitted model object. Methods are implemented for
8
#'  [mkinfit()] objects and for [mmkin()] objects.
9
#' @param \dots Not used
10
#' @return For mkinfit objects, a numeric vector of fitted model parameters.
11
#'  For mmkin row objects, a matrix with the parameters with a
12
#'  row for each dataset. If the mmkin object has more than one row, a list of
13
#'  such matrices is returned.
14
#' @examples
15
#' # mkinfit objects
16
#' fit <- mkinfit("SFO", FOCUS_2006_C, quiet = TRUE)
17
#' parms(fit)
18
#' parms(fit, transformed = TRUE)
19
#'
20
#' # mmkin objects
21
#' ds <- lapply(experimental_data_for_UBA_2019[6:10],
22
#'  function(x) subset(x$data[c("name", "time", "value")]))
23
#' names(ds) <- paste("Dataset", 6:10)
24
#' \dontrun{
25
#' fits <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE, cores = 1)
26
#' parms(fits["SFO", ])
27
#' parms(fits[, 2])
28
#' parms(fits)
29
#' parms(fits, transformed = TRUE)
30
#' }
31
#' @export
32
parms <- function(object, ...)
33
{
34 1
  UseMethod("parms", object)
35
}
36

37
#' @param transformed Should the parameters be returned
38
#'   as used internally during the optimisation?
39
#' @rdname parms
40
#' @export
41
parms.mkinfit <- function(object, transformed = FALSE, ...)
42
{
43 1
  if (transformed) object$par
44 1
  else c(object$bparms.optim, object$errparms)
45
}
46

47
#' @rdname parms
48
#' @export
49
parms.mmkin <- function(object, transformed = FALSE, ...)
50
{
51 1
  if (nrow(object) == 1) {
52 1
    res <- sapply(object, parms, transformed = transformed, ...)
53 1
    colnames(res) <- colnames(object)
54
  } else {
55 0
    res <- list()
56 0
    for (i in 1:nrow(object)) {
57 0
      res[[i]] <- parms(object[i, ], transformed = transformed, ...)
58
    }
59 0
    names(res) <- rownames(object)
60
  }
61 1
  return(res)
62
}

Read our documentation on viewing source code .

Loading