1
#' Update an mkinfit model with different arguments
2
#'
3
#' This function will return an updated mkinfit object. The fitted degradation
4
#' model parameters from the old fit are used as starting values for the
5
#' updated fit. Values specified as 'parms.ini' and/or 'state.ini' will
6
#' override these starting values.
7
#'
8
#' @param object An mkinfit object to be updated
9
#' @param \dots Arguments to \code{\link{mkinfit}} that should replace
10
#'  the arguments from the original call. Arguments set to NULL will
11
#'  remove arguments given in the original call
12
#' @param evaluate Should the call be evaluated or returned as a call
13
#' @examples
14
#' \dontrun{
15
#' fit <- mkinfit("SFO", subset(FOCUS_2006_D, value != 0), quiet = TRUE)
16
#' parms(fit)
17
#' plot_err(fit)
18
#' fit_2 <- update(fit, error_model = "tc")
19
#' parms(fit_2)
20
#' plot_err(fit_2)
21
#' }
22
#' @export
23
update.mkinfit <- function(object, ..., evaluate = TRUE)
24
{
25 2
  call <- object$call
26

27 2
  update_arguments <- match.call(expand.dots = FALSE)$...
28

29
  # Get optimised ODE parameters and let parms.ini override them
30 2
  ode_optim_names <- intersect(names(object$bparms.optim), names(object$bparms.ode))
31 2
  ode_start <- object$bparms.optim[ode_optim_names]
32 2
  if ("parms.ini" %in% names(update_arguments)) {
33 0
    ode_start[names(update_arguments["parms.ini"])] <- update_arguments["parms.ini"]
34
  }
35 2
  if (length(ode_start)) update_arguments[["parms.ini"]] <- ode_start
36

37
  # Get optimised values for initial states and let state.ini override them
38 2
  state_optim_names <- intersect(names(object$bparms.optim), paste0(names(object$bparms.state), "_0"))
39 2
  state_start <- object$bparms.optim[state_optim_names]
40 2
  names(state_start) <- gsub("_0$", "", names(state_start))
41 2
  if ("state.ini" %in% names(update_arguments)) {
42 0
    state_start[names(update_arguments["state.ini"])] <- update_arguments["state.ini"]
43
  }
44 2
  if (length(state_start)) update_arguments[["state.ini"]] <- state_start
45

46 2
  if (length(update_arguments) > 0) {
47 2
    update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))
48

49 2
    for (a in names(update_arguments)[update_arguments_in_call]) {
50 2
      call[[a]] <- update_arguments[[a]]
51
    }
52

53 2
    update_arguments_not_in_call <- !update_arguments_in_call
54 2
    if(any(update_arguments_not_in_call)) {
55 2
      call <- c(as.list(call), update_arguments[update_arguments_not_in_call])
56 2
      call <- as.call(call)
57
    }
58
  }
59 2
  if(evaluate) eval(call, parent.frame())
60 0
  else call
61
}

Read our documentation on viewing source code .

Loading