From 4c69847346a9c254e4e803b6987a63e3fd9c14ae Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 26 Jun 2015 08:50:13 +0200 Subject: Subsetting and plotting for mmkin objects Including documentation and documentation improvements for mmkin(). --- NAMESPACE | 2 ++ NEWS.md | 4 ++- R/mmkin.R | 28 +++++++++++++++++++ R/plot.mmkin.R | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++ man/Extract.mmkin.Rd | 36 ++++++++++++++++++++++++ man/mmkin.Rd | 6 ++-- man/plot.mmkin.Rd | 50 +++++++++++++++++++++++++++++++++ 7 files changed, 201 insertions(+), 4 deletions(-) create mode 100644 R/plot.mmkin.R create mode 100644 man/Extract.mmkin.Rd create mode 100644 man/plot.mmkin.Rd diff --git a/NAMESPACE b/NAMESPACE index ce6dc5b4..abbbc658 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,8 @@ exportPattern(".") S3method(plot, mkinfit) S3method(summary, mkinfit) S3method(print, summary.mkinfit) +S3method(plot, mmkin) +S3method("[", mmkin) # Import packages listed as Imports or Depends import( diff --git a/NEWS.md b/NEWS.md index 1a4c24ed..8109ce7a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,9 @@ ### 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. +- 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. A subsetting method with single brackets is available. + +- New function `plot.mmkin()`: Plots single-row or single-column `mmkin` objects including residual plots. ## CHANGES in mkin VERSION 0.9-38 (2015-06-24) diff --git a/R/mmkin.R b/R/mmkin.R index 1e1c4a33..be4526af 100644 --- a/R/mmkin.R +++ b/R/mmkin.R @@ -1,3 +1,24 @@ +# Copyright (C) 2015 Johannes Ranke +# Contact: jranke@uni-bremen.de +# The summary function is an adapted and extended version of summary.modFit +# from the FME package, v 1.1 by Soetart and Petzoldt, which was in turn +# inspired by summary.nls.lm + +# This file is part of the R package mkin + +# mkin is free software: you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see + mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, cores = round(detectCores()/2), cluster = NULL, ...) { @@ -44,3 +65,10 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, class(results) <- "mmkin" return(results) } + +"[.mmkin" <- function(x, i, j, ..., drop = FALSE) { + class(x) <- NULL + x_sub <- x[i, j, drop = drop] + if (!drop) class(x_sub) <- "mmkin" + return(x_sub) +} diff --git a/R/plot.mmkin.R b/R/plot.mmkin.R new file mode 100644 index 00000000..036ec59f --- /dev/null +++ b/R/plot.mmkin.R @@ -0,0 +1,79 @@ +# Copyright (C) 2015 Johannes Ranke +# Contact: jranke@uni-bremen.de +# The summary function is an adapted and extended version of summary.modFit +# from the FME package, v 1.1 by Soetart and Petzoldt, which was in turn +# inspired by summary.nls.lm + +# This file is part of the R package mkin + +# mkin is free software: you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see + +plot.mmkin <- function(x, main = "auto", legends = 1, errmin_var = "All data", errmin_digits = 2, + cex = 0.7, rel.height.middle = 0.9, ...) { + n.m <- nrow(x) + n.d <- ncol(x) + if (n.m > 1 & n.d > 1) stop("Please select fits either for one model or for one dataset") + if (n.m == 1 & n.d == 1) loop_over = "none" + if (n.m > 1) loop_over <- "models" + if (n.d > 1) loop_over <- "datasets" + n.fits <- length(x) + + if (main == "auto") { + main = switch(loop_over, + none = paste(rownames(x), colnames(x)), + models = colnames(x), + datasets = rownames(x)) + } + + oldpar <- par(no.readonly = TRUE) + rel.heights <- if (n.fits > 2) c(1, rep(rel.height.middle, n.fits - 2), 1) + else rep(1, n.fits) + layout(matrix(1:(2 * n.fits), n.fits, 2, byrow = TRUE), heights = rel.heights) + + #par(mfrow = c(n.fits, 2)) + par(mar = c(3.0, 4.1, 4.1, 2.1)) # Reduce bottom margin by 2.1 - hides x axis legend + par(cex = cex) + + for (i.fit in 1:n.fits) { + if (i.fit == 2) { + # Reduce top margin by 2 after the first plot as we have no main title, + # reduced plot height, therefore we need rel.height.middle in the layout + par(mar = c(3.0, 4.1, 2.1, 2.1)) + } + if (i.fit == n.fits) { + # Reduce top margin by 2 after the first plot as we have no main title, + # plot height remains about constant + par(mar = c(5.1, 4.1, 2.1, 2.1)) + + } + fit <- x[[i.fit]] + plot(fit, legend = legends == i.fit, ...) + + title(main, outer = TRUE, line = -2) + + fit_name <- switch(loop_over, + models = rownames(x)[i.fit], + datasets = colnames(x)[i.fit], + none = "") + + if (!is.null(errmin_var)) { + chi2 <- paste0(round(100 * mkinerrmin(fit)[errmin_var, "err.min"], errmin_digits), "%") + mtext(bquote(.(fit_name) ~ chi^2 ~ "error level" == .(chi2)), cex = cex, line = 0.4) + } + mkinresplot(fit, legend = FALSE, ...) + mtext(paste(fit_name, "residuals"), cex = cex, line = 0.4) + } + + par(oldpar, no.readonly = TRUE) +} diff --git a/man/Extract.mmkin.Rd b/man/Extract.mmkin.Rd new file mode 100644 index 00000000..769f2f5a --- /dev/null +++ b/man/Extract.mmkin.Rd @@ -0,0 +1,36 @@ +\name{[.mmkin} +\alias{[.mmkin} +\title{Subsetting method for mmkin objects} +\usage{ +\method{[}{mmkin}(x, i, j, ..., drop = FALSE) +} +\description{ + Subsetting method for mmkin objects. +} +\arguments{ +\item{x}{An \code{\link{mmkin} object}} + +\item{i}{Row index selecting the fits for specific models} + +\item{j}{Column index selecting the fits to specific datasets} + +\item{...}{Not used, only there to satisfy the generic method definition} + +\item{drop}{If FALSE, the method always returns an mmkin object, otherwise either + a list of mkinfit objects or a single mkinfit object.} +} +\value{ + An object of class \code{\link{mmkin}}. +} +\author{ + Johannes Ranke +} +\examples{ + fits <- mmkin(c("SFO", "FOMC"), list(B = FOCUS_2006_B, C = FOCUS_2006_C)) + fits["FOMC", ] + fits[, "B"] + fits[, "B", drop = TRUE]$FOMC + fits["SFO", "B"] + fits[["SFO", "B"]] # This is equivalent to + fits["SFO", "B", drop = TRUE] +} diff --git a/man/mmkin.Rd b/man/mmkin.Rd index 0b35738a..4859d658 100644 --- a/man/mmkin.Rd +++ b/man/mmkin.Rd @@ -4,8 +4,8 @@ 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. + This function calls \code{\link{mkinfit}} on all combinations of models and datasets + specified in its first two arguments. } \usage{ mmkin(models, datasets, @@ -26,7 +26,7 @@ mmkin(models, datasets, used when the \code{cluster} argument is \code{NULL}. } \item{cluster}{ - A cluster as returned by \code{link{makeCluster}} to be used for parallel + A cluster as returned by \code{\link{makeCluster}} to be used for parallel execution. } \item{\dots}{ diff --git a/man/plot.mmkin.Rd b/man/plot.mmkin.Rd new file mode 100644 index 00000000..4f78de2c --- /dev/null +++ b/man/plot.mmkin.Rd @@ -0,0 +1,50 @@ +\name{plot.mmkin} +\alias{plot.mmkin} +\title{ + Plot model fits (observed and fitted) and the residuals for a row or column of an mmkin object. +} +\description{ + When x is a row selected from an mmkin object (\code{\link{[.mmkin}}), the same model + fitted for at least one dataset is shown. When it is a column, the fit of at least one model + to the same dataset is shown. +} +\usage{ +\method{plot}{mmkin}(x, main = "auto", legends = 1, errmin_var = "All data", errmin_digits = 2, + cex = 0.7, rel.height.middle = 0.9, ...) +} +\arguments{ + \item{x}{ + An object of class \{code{\link{mmkin}}, with either one row or one column. +} + \item{main}{ + The main title placed on the outer margin of the plot. +} + \item{legends}{ + An index for the fits for which legends should be shown. +} + \item{errmin_var}{ + The variable for which the FOCUS chi2 error value should be shown. +} + \item{errmin_digits}{ + The number of digits for rounding the FOCUS chi2 error percentage. +} + \item{cex}{ + Passed to the plot functions and \code{\link{mtext}}. +} + \item{rel.height.middle}{ + The relative height of the middle plot. +} + \item{\dots}{ + Further arguments passed to \code{\link{plot.mkinfit}} and \code{\link{mkinresplot}}. +} +} +\value{ + The function is called for its side effect. +} +\author{ + Johannes Ranke +} +\examples{ + fits <- mmkin(c("SFO", "FOMC"), list("FOCUS B" = FOCUS_2006_B, "FOCUS C" = FOCUS_2006_C)) + plot(fits[, "FOCUS C"]) +} -- cgit v1.2.1