aboutsummaryrefslogtreecommitdiff
path: root/R/nlme.mmkin.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2020-10-27 15:34:14 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2020-10-27 15:36:46 +0100
commita5874ab7fce4616e80be69366ff0685332f47bf1 (patch)
tree17f36842de8ff457879be152779f8704f06a4787 /R/nlme.mmkin.R
parentca1b4c8cdb1de72b44df0ee8cebe11e10814efdf (diff)
Add summary method for nlme.mmkin objects
Improve and update docs
Diffstat (limited to 'R/nlme.mmkin.R')
-rw-r--r--R/nlme.mmkin.R46
1 files changed, 40 insertions, 6 deletions
diff --git a/R/nlme.mmkin.R b/R/nlme.mmkin.R
index d3369cf5..6d24a044 100644
--- a/R/nlme.mmkin.R
+++ b/R/nlme.mmkin.R
@@ -42,6 +42,9 @@ get_deg_func <- function() {
#' @importFrom stats na.fail as.formula
#' @return Upon success, a fitted nlme.mmkin object, which is an nlme object
#' with additional elements
+#' @note As the object inherits from [nlme::nlme], there is a wealth of
+#' methods that will automatically work on 'nlme.mmkin' objects, such as
+#' [nlme::intervals()], [nlme::anova.lme()] and [nlme::coef.lme()].
#' @export
#' @seealso \code{\link{nlme_function}}
#' @examples
@@ -141,8 +144,8 @@ nlme.mmkin <- function(model, data = sys.frame(sys.parent()),
thisCall[["model"]] <- this_model
- mean_dp <- mean_degparms(model)
- dp_names <- names(mean_dp)
+ mean_dp_start <- mean_degparms(model)
+ dp_names <- names(mean_dp_start)
thisCall[["data"]] <- nlme_data(model)
@@ -175,10 +178,21 @@ nlme.mmkin <- function(model, data = sys.frame(sys.parent()),
thisCall[["control"]] <- control
}
- val <- do.call("nlme.formula", thisCall)
+ fit_time <- system.time(val <- do.call("nlme.formula", thisCall))
+ val$time <- fit_time
+
+ val$mean_dp_start <- mean_dp_start
val$mmkin_orig <- model
val$data <- thisCall[["data"]]
val$mkinmod <- model[[1]]$mkinmod
+ val$err_mode <- error_model
+ val$transform_rates <- model[[1]]$transform_rates
+ val$transform_fractions <- model[[1]]$transform_fractions
+ val$solution_type <- model[[1]]$solution_type
+ val$date.fit <- date()
+ val$nlmeversion <- as.character(utils::packageVersion("nlme"))
+ val$mkinversion <- as.character(utils::packageVersion("mkin"))
+ val$Rversion <- paste(R.version$major, R.version$minor, sep=".")
class(val) <- c("nlme.mmkin", "nlme", "lme")
return(val)
}
@@ -186,10 +200,30 @@ nlme.mmkin <- function(model, data = sys.frame(sys.parent()),
#' @export
#' @rdname nlme.mmkin
#' @param x An nlme.mmkin object to print
-#' @param ... Further arguments as in the generic
print.nlme.mmkin <- function(x, ...) {
- x$call$data <- "Not shown"
- NextMethod("print", x)
+ cat( "Kinetic nonlinear mixed-effects model fit by " )
+ cat( if(x$method == "REML") "REML\n" else "maximum likelihood\n")
+ cat("\nStructural model:\n")
+ diffs <- x$mmkin_orig[[1]]$mkinmod$diffs
+ nice_diffs <- gsub("^(d.*) =", "\\1/dt =", diffs)
+ writeLines(strwrap(nice_diffs, exdent = 11))
+ cat("\nData:\n")
+ cat(nrow(x$data), "observations of",
+ length(unique(x$data$name)), "variable(s) grouped in",
+ length(unique(x$data$ds)), "datasets\n")
+ cat("\nLog-", if(x$method == "REML") "restricted-" else "",
+ "likelihood: ", format(x$logLik), "\n", sep = "")
+ fixF <- x$call$fixed
+ cat("\nFixed effects:\n",
+ deparse(
+ if(inherits(fixF, "formula") || is.call(fixF) || is.name(fixF))
+ x$call$fixed
+ else
+ lapply(fixF, function(el) as.name(deparse(el)))), "\n")
+ print(fixef(x), ...)
+ cat("\n")
+ print(summary(x$modelStruct), sigma = x$sigma, ...)
+ invisible(x)
}
#' @export

Contact - Imprint