Add likelihood ratio test and other methods, fixes

The likelihood ratio test method is lrtest, in addition,
methods for update and residuals were added.

1 files changed, 57 insertions, 0 deletions

diff --git a/R/update.mkinfit.R b/R/update.mkinfit.R
new file mode 100644
index 00000000..2f0814e0
--- /dev/null
+++ b/R/update.mkinfit.R
@@ -0,0 +1,57 @@
+#' Update an mkinfit model with different arguments
+#'
+#' This function will return an updated mkinfit object. The fitted degradation
+#' model parameters from the old fit are used as starting values for the
+#' updated fit. Values specified as 'parms.ini' and/or 'state.ini' will
+#' override these starting values.
+#'
+#' @param object An mkinfit object to be updated
+#' @param \dots Arguments to \code{\link{mkinfit}} that should replace
+#'  the arguments from the original call. Arguments set to NULL will
+#'  remove arguments given in the original call
+#' @param evaluate Should the call be evaluated or returned as a call
+#' @examples
+#' \dontrun{
+#' fit <- mkinfit("DFOP", subset(FOCUS_2006_D, value != 0), quiet = TRUE)
+#' update(fit, error_model = "tc")
+#' }
+#' @export
+update.mkinfit <- function(object, ..., evaluate = TRUE)
+{
+  call <- object$call
+
+  update_arguments <- match.call(expand.dots = FALSE)$...
+
+  # Get optimised ODE parameters and let parms.ini override them
+  ode_optim_names <- intersect(names(object$bparms.optim), names(object$bparms.ode))
+  ode_start <- object$bparms.optim[ode_optim_names]
+  if ("parms.ini" %in% names(update_arguments)) {
+    ode_start[names(update_arguments["parms.ini"])] <- update_arguments["parms.ini"]
+  }
+  if (length(ode_start)) update_arguments[["parms.ini"]] <- ode_start
+
+  # Get optimised values for initial states and let state.ini override them
+  state_optim_names <- intersect(names(object$bparms.optim), paste0(names(object$bparms.state), "_0"))
+  state_start <- object$bparms.optim[state_optim_names]
+  names(state_start) <- gsub("_0$", "", names(state_start))
+  if ("state.ini" %in% names(update_arguments)) {
+    state_start[names(update_arguments["state.ini"])] <- update_arguments["state.ini"]
+  }
+  if (length(state_start)) update_arguments[["state.ini"]] <- state_start
+
+  if (length(update_arguments) > 0) {
+    update_arguments_in_call <- !is.na(match(names(update_arguments), names(call)))
+
+    for (a in names(update_arguments)[update_arguments_in_call]) {
+      call[[a]] <- update_arguments[[a]]
+    }
+
+    update_arguments_not_in_call <- !update_arguments_in_call
+    if(any(update_arguments_not_in_call)) {
+      call <- c(as.list(call), update_arguments[update_arguments_not_in_call])
+      call <- as.call(call)
+    }
+  }
+  if(evaluate) eval(call, parent.frame())
+  else call
+}