diff options
| author | Johannes Ranke <jranke@uni-bremen.de> | 2015-06-25 11:32:34 +0200 | 
|---|---|---|
| committer | Johannes Ranke <jranke@uni-bremen.de> | 2015-06-25 11:32:34 +0200 | 
| commit | c3d6dde60cb368f403ffe0285db27e218f669990 (patch) | |
| tree | 0d356630c1a74aa468c3d941a0bc861ec495b3a6 | |
| parent | 5a58193c861c9b8e19f211db8711f432a3a93d85 (diff) | |
Add mmkin for testing
| -rw-r--r-- | NEWS.md | 4 | ||||
| -rw-r--r-- | R/mmkin.R | 46 | ||||
| -rw-r--r-- | man/mmkin.Rd | 64 | 
3 files changed, 113 insertions, 1 deletions
| @@ -1,6 +1,8 @@  # CHANGES in mkin VERSION 0.9-39 -  +## MAJOR CHANGES + +- New function `mmkin()`: This function takes a character vector of model shorthand names, or alternatively a list of mkinmod models, as well as a list of dataset as main arguments. It returns a matrix of mkinfit objects, with a row for each model and a column for each dataset.  # CHANGES in mkin VERSION 0.9-38 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) +} diff --git a/man/mmkin.Rd b/man/mmkin.Rd new file mode 100644 index 00000000..64e7ae27 --- /dev/null +++ b/man/mmkin.Rd @@ -0,0 +1,64 @@ +\name{mmkin} +\alias{mmkin} +\title{ +  Fit one or more kinetic models with one or more state variables to one or more datasets +} +\description{ +  This code calls \code{\link{mkinfit}} on each combination of model and dataset +  given in its first two arguments. +} +\usage{ +mmkin(models, datasets, +      cores = round(detectCores()/2), cluster = NULL, ...) +} +\arguments{ +  \item{models}{ +    Either a character vector of shorthand names ("SFO", "FOMC", "DFOP", +    "HS", "SFORB"), or an optionally named list of \code{\link{mkinmod}} +    objects. +  } +  \item{datasets}{ +    An optionally named list of datasets suitable as observed data for +    \code{\link{mkinfit}}. +  } +  \item{cores}{ +    The number of cores to be used for multicore processing. This is only +    used when the \code{cluster} argument is \code{NULL}. +  } +  \item{cluster}{ +    A cluster as returned by \code{link{makeCluster}} to be used for parallel  +    execution. +  } +  \item{\dots}{ +    Further arguments that will be passed to \code{\link{mkinfit}}.  +  } +} +\value{ +  A matrix of "mkinfit" objects that can be indexed using the  +  model and dataset names as row and column indices. +} +\author{ +  Johannes Ranke +} +\examples{ +\dontrun{ +m_synth_SFO_lin <- mkinmod(parent = list(type = "SFO", to = "M1"), +                           M1 = list(type = "SFO", to = "M2"), +                           M2 = list(type = "SFO"), use_of_ff = "max") + +m_synth_FOMC_lin <- mkinmod(parent = list(type = "FOMC", to = "M1"), +                           M1 = list(type = "SFO", to = "M2"), +                           M2 = list(type = "SFO"), use_of_ff = "max") + +models <- list(SFO_lin = m_synth_SFO_lin, FOMC_lin = m_synth_FOMC_lin) +datasets <- lapply(synthetic_data_for_UBA_2014[1:3], function(x) x$data) + +time_default <- system.time(fits <- mmkin(models, datasets)) +time_1 <- system.time(fits.1 <- mmkin(models, datasets, cores = 1)) + +time_default +time_1 + +endpoints(fits[["SFO_lin", 2]]) +} +\keyword{ optimize } | 
