From bbb74d4f60033899cd5cdd36aa70f157bc52209e Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 1 Nov 2019 12:19:03 +0100
Subject: Fix bug in yesterdays release, add methods for BIC

---
 R/AIC.mmkin.R | 32 +++++++++++++++++++++++++-------
 1 file changed, 25 insertions(+), 7 deletions(-)

(limited to 'R/AIC.mmkin.R')

diff --git a/R/AIC.mmkin.R b/R/AIC.mmkin.R
index ab17f0a0..7d405c4a 100644
--- a/R/AIC.mmkin.R
+++ b/R/AIC.mmkin.R
@@ -1,8 +1,9 @@
-#' Calculated the AIC for a column of an mmkin object
-#' 
+#' Calculate the AIC for a column of an mmkin object
+#'
 #' Provides a convenient way to compare different kinetic models fitted to the
 #' same dataset.
-#' 
+#'
+#' @importFrom stats AIC BIC
 #' @param object An object of class \code{\link{mmkin}}, containing only one
 #'   column.
 #' @param \dots For compatibility with the generic method
@@ -11,22 +12,22 @@
 #'   dataframe if there are several fits in the column).
 #' @author Johannes Ranke
 #' @examples
-#' 
+#'
 #'   \dontrun{ # skip, as it takes > 10 s on winbuilder
 #'   f <- mmkin(c("SFO", "FOMC", "DFOP"),
 #'     list("FOCUS A" = FOCUS_2006_A,
 #'          "FOCUS C" = FOCUS_2006_C), cores = 1, quiet = TRUE)
 #'   AIC(f[1, "FOCUS A"]) # We get a single number for a single fit
-#' 
+#'
 #'   # For FOCUS A, the models fit almost equally well, so the higher the number
 #'   # of parameters, the higher (worse) the AIC
 #'   AIC(f[, "FOCUS A"])
 #'   AIC(f[, "FOCUS A"], k = 0) # If we do not penalize additional parameters, we get nearly the same
-#' 
+#'
 #'   # For FOCUS C, the more complex models fit better
 #'   AIC(f[, "FOCUS C"])
 #'   }
-#' 
+#'
 #' @export
 AIC.mmkin <- function(object, ..., k = 2)
 {
@@ -42,3 +43,20 @@ AIC.mmkin <- function(object, ..., k = 2)
   if (n.fits > 1) rownames(res) <- model_names
   return(res)
 }
+
+#' @rdname AIC.mmkin
+#' @export
+BIC.mmkin <- function(object, ...)
+{
+  # We can only handle a single column
+  if (ncol(object) != 1) stop("Please provide a single column object")
+  n.fits <- length(object)
+  model_names <- rownames(object)
+
+  code <- paste0("BIC(",
+    paste0("object[[", 1:n.fits, "]]", collapse = ", "),
+    ")")
+  res <- eval(parse(text = code))
+  if (n.fits > 1) rownames(res) <- model_names
+  return(res)
+}
-- 
cgit v1.2.1