From 808a679efb69ec6603db6642687d9e8ceb3b3453 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 14 May 2020 18:39:29 +0200
Subject: Add a parms method for mmkin objects

---
 R/parms.mkinfit.R | 34 ++++++++++++++++++++++++++++++++--
 1 file changed, 32 insertions(+), 2 deletions(-)

(limited to 'R/parms.mkinfit.R')

diff --git a/R/parms.mkinfit.R b/R/parms.mkinfit.R
index 281d06de..f173ef51 100644
--- a/R/parms.mkinfit.R
+++ b/R/parms.mkinfit.R
@@ -4,9 +4,13 @@
 #' model parameters, in order to avoid working with a fitted model without
 #' considering the error structure that was assumed for the fit.
 #'
-#' @param object A fitted model object
+#' @param object A fitted model object. Methods are implemented for
+#'  [mkinfit()] objects and for [mmkin()] objects.
 #' @param \dots Not used
-#' @return A numeric vector of fitted model parameters
+#' @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.
 #' @export
 parms <- function(object, ...)
 {
@@ -26,3 +30,29 @@ parms.mkinfit <- function(object, transformed = FALSE, ...)
   if (transformed) object$par
   else c(object$bparms.optim, object$errparms)
 }
+
+#' @rdname parms
+#' @examples
+#' ds <- lapply(experimental_data_for_UBA_2019[6:10],
+#'  function(x) subset(x$data[c("name", "time", "value")]))
+#' names(ds) <- paste("Dataset", 6:10)
+#' fits <- mmkin(c("SFO", "FOMC", "DFOP"), ds, quiet = TRUE)
+#' parms(fits["SFO", ])
+#' parms(fits[, 2])
+#' parms(fits)
+#' parms(fits, transformed = TRUE)
+#' @export
+parms.mmkin <- function(object, transformed = FALSE, ...)
+{
+  if (nrow(object) == 1) {
+    res <- sapply(object, parms, transformed = transformed, ...)
+    colnames(res) <- colnames(object)
+  } else {
+    res <- list()
+    for (i in 1:nrow(object)) {
+      res[[i]] <- parms(object[i, ], transformed = transformed, ...)
+    }
+    names(res) <- rownames(object)
+  }
+  return(res)
+}
-- 
cgit v1.2.1