From c3d6dde60cb368f403ffe0285db27e218f669990 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 25 Jun 2015 11:32:34 +0200
Subject: Add mmkin for testing

---
 R/mmkin.R | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 R/mmkin.R

(limited to 'R')

diff --git a/R/mmkin.R b/R/mmkin.R
new file mode 100644
index 00000000..fe9db194
--- /dev/null
+++ b/R/mmkin.R
@@ -0,0 +1,46 @@
+mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, 
+                  cores = round(detectCores()/2), cluster = NULL, ...) 
+{
+  parent_models_available = c("SFO", "FOMC", "DFOP", "HS", "SFORB", "IORE") 
+  n.m <- length(models)
+  n.d <- length(datasets)
+  n.fits <- n.m * n.d
+  fit_indices <- matrix(1:n.fits, ncol = n.d)
+
+  # Check models and define their names
+  if (!all(sapply(models, function(x) inherits(x, "mkinmod")))) {
+    if (!all(models %in% parent_models_available)) {
+      stop("Please supply models as a list of mkinmod objects or a vector combined of\n  ",
+           paste(parent_models_available, collapse = ", ")) 
+    } else {
+      names(models) <- models
+    } 
+  } else {
+    if (is.null(names(models))) names(models) <- as.character(1:n.m)
+  }
+
+  # Check datasets and define their names
+  if (is.null(names(datasets))) names(datasets) <- as.character(1:n.d)
+
+  # Define names for fit index
+  dimnames(fit_indices) <- list(model = names(models),
+                                dataset = names(datasets))
+
+
+  fit_function <- function(fit_index) {
+    w <- which(fit_indices == fit_index, arr.ind = TRUE)
+    model_index <- w[1]
+    dataset_index <- w[2]
+    mkinfit(models[[model_index]], datasets[[dataset_index]], ...)
+  }
+
+  if (is.null(cluster)) {
+    results <- mclapply(as.list(1:n.fits), fit_function, mc.cores = cores)
+  } else {
+    results <- parLapply(cluster, list(1:n.fit), fit_function)
+  }
+
+  attributes(results) <- attributes(fit_indices)
+  class(results) <- "mmkin"
+  return(results)
+}
-- 
cgit v1.2.1