Merge branch 'master' into mxkin

Merge DESCRIPTION manually to combine dependencies and rerun check to
update check.log

4 files changed, 105 insertions, 95 deletions

diff --git a/R/endpoints.R b/R/endpoints.R
index 14beadea..f7ee483a 100644
--- a/R/endpoints.R
+++ b/R/endpoints.R
@@ -1,12 +1,12 @@
 #' Function to calculate endpoints for further use from kinetic models fitted
 #' with mkinfit
-#' 
+#'
 #' This function calculates DT50 and DT90 values as well as formation fractions
 #' from kinetic models fitted with mkinfit. If the SFORB model was specified
 #' for one of the parents or metabolites, the Eigenvalues are returned. These
 #' are equivalent to the rate constantes of the DFOP model, but with the
 #' advantage that the SFORB model can also be used for metabolites.
-#' 
+#'
 #' @param fit An object of class \code{\link{mkinfit}}.
 #' @importFrom stats optimize
 #' @return A list with the components mentioned above.
@@ -14,10 +14,10 @@
 #' @author Johannes Ranke
 #' @keywords manip
 #' @examples
-#' 
+#'
 #'   fit <- mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE)
-#'   endpoints(fit)  
-#' 
+#'   endpoints(fit)
+#'
 #' @export
 endpoints <- function(fit) {
   # Calculate dissipation times DT50 and DT90 and formation
@@ -29,8 +29,9 @@ endpoints <- function(fit) {
   parms.all <- c(fit$bparms.optim, fit$bparms.fixed)
   ep$ff <- vector()
   ep$SFORB <- vector()
-  ep$distimes <- data.frame(DT50 = rep(NA, length(obs_vars)),
-			    DT90 = rep(NA, length(obs_vars)),
+  ep$distimes <- data.frame(
+    DT50 = rep(NA, length(obs_vars)),
+    DT90 = rep(NA, length(obs_vars)),
     row.names = obs_vars)
   for (obs_var in obs_vars) {
     type = names(fit$mkinmod$map[[obs_var]])[1]
@@ -41,8 +42,8 @@ endpoints <- function(fit) {
       f_values = parms.all[f_names]
       f_to_sink = 1 - sum(f_values)
       names(f_to_sink) = ifelse(type == "SFORB",
-                              paste(obs_var, "free", "sink", sep = "_"),
-                              paste(obs_var, "sink", sep = "_"))
+        paste(obs_var, "free", "sink", sep = "_"),
+        paste(obs_var, "sink", sep = "_"))
       for (f_name in f_names) {
         ep$ff[[sub("f_", "", sub("_to_", "_", f_name))]] = f_values[[f_name]]
       }
@@ -195,5 +196,6 @@ endpoints <- function(fit) {
     }
     ep$distimes[obs_var, c("DT50", "DT90")] = c(DT50, DT90)
   }
+  if (length(ep$SFORB) == 0) ep$SFORB <- NULL
   return(ep)
 }
diff --git a/R/mkinds.R b/R/mkinds.R
index a66adb14..d6f296bf 100644
--- a/R/mkinds.R
+++ b/R/mkinds.R
@@ -1,43 +1,50 @@
 #' A dataset class for mkin
 #' 
-#' A dataset class for mkin
-#' 
-#' @name mkinds
-#' @docType class
-#' @format An \code{\link{R6Class}} generator object.
-#' @section Fields:
-#' 
-#' \describe{ \item{list("title")}{A full title for the dataset}
-#' 
-#' \item{list("sampling")}{times The sampling times}
-#' 
-#' \item{list("time_unit")}{The time unit}
-#' 
-#' \item{list("observed")}{Names of the observed compounds}
-#' 
-#' \item{list("unit")}{The unit of the observations}
-#' 
-#' \item{list("replicates")}{The number of replicates}
-#' 
-#' \item{list("data")}{A dataframe with at least the columns name, time and
-#' value in order to be compatible with mkinfit} }
+#' @description
+#' At the moment this dataset class is hardly used in mkin. For example,
+#' mkinfit does not take mkinds datasets as argument, but works with dataframes
+#' such as the on contained in the data field of mkinds objects. Some datasets
+#' provided by this package come as mkinds objects nevertheless.
+#'
 #' @importFrom R6 R6Class
-#' @keywords datasets
+#' @seealso The S3 printing method \code{\link{print.mkinds}}
 #' @examples
 #' 
 #' mds <- mkinds$new("FOCUS A", FOCUS_2006_A)
+#' print(mds)
 #' 
 #' @export
 mkinds <- R6Class("mkinds",
   public = list(
+
+    #' @field title A full title for the dataset
     title = NULL,
+
+    #' @field sampling_times The sampling times
     sampling_times = NULL,
+
+    #' @field time_unit The time unit
     time_unit = NULL,
+
+    #' @field observed Names of the observed variables
     observed = NULL,
+
+    #' @field unit The unit of the observations
     unit = NULL,
+
+    #' @field replicates The maximum number of replicates per sampling time
     replicates = NULL,
+
+    #' @field data A data frame with at least the columns name, time
+    #' and value in order to be compatible with mkinfit
     data = NULL,
 
+    #' @description
+    #' Create a new mkinds object
+    #' @param title The dataset title
+    #' @param data The data
+    #' @param time_unit The time unit
+    #' @param unit The unit of the observations
     initialize = function(title = "", data, time_unit = NA, unit = NA) {
 
       self$title <- title
@@ -56,8 +63,6 @@ mkinds <- R6Class("mkinds",
 
 #' Print mkinds objects
 #' 
-#' Print mkinds objects.
-#' 
 #' @param x An \code{\link{mkinds}} object.
 #' @param \dots Not used.
 #' @export
diff --git a/R/mkinmod.R b/R/mkinmod.R
index a1ae0021..cfd40504 100644
--- a/R/mkinmod.R
+++ b/R/mkinmod.R
@@ -33,6 +33,7 @@
 #' @param verbose If \code{TRUE}, passed to \code{\link{cfunction}} if
 #'   applicable to give detailed information about the C function being built.
 #' @importFrom methods signature
+#' @importFrom pkgbuild has_compiler
 #' @importFrom inline cfunction
 #' @return A list of class \code{mkinmod} for use with \code{\link{mkinfit}},
 #'   containing, among others,
@@ -364,79 +365,77 @@ mkinmod <- function(..., use_of_ff = "min", speclist = NULL, quiet = FALSE, verb
     model$coefmat <- m
   }#}}}
 
-  # Try to create a function compiled from C code if more than one observed {{{
-  # variable and gcc is available
-  if (length(obs_vars) > 1) {
-    if (Sys.which("gcc") != "") {
+  # Try to create a function compiled from C code there is more than one observed variable {{{
+  # and a compiler is available
+  if (length(obs_vars) > 1 & has_compiler()) {
 
-      # Translate the R code for the derivatives to C code
-      diffs.C <- paste(diffs, collapse = ";\n")
-      diffs.C <- paste0(diffs.C, ";")
+    # Translate the R code for the derivatives to C code
+    diffs.C <- paste(diffs, collapse = ";\n")
+    diffs.C <- paste0(diffs.C, ";")
 
-      # HS
-      diffs.C <- gsub(HS_decline, "(time <= tb ? k1 : k2)", diffs.C, fixed = TRUE)
+    # HS
+    diffs.C <- gsub(HS_decline, "(time <= tb ? k1 : k2)", diffs.C, fixed = TRUE)
 
-      for (i in seq_along(diffs)) {
-        state_var <- names(diffs)[i]
+    for (i in seq_along(diffs)) {
+      state_var <- names(diffs)[i]
 
-        # IORE
-        if (state_var %in% obs_vars) {
-          if (spec[[state_var]]$type == "IORE") {
-            diffs.C <- gsub(paste0(state_var, "^N_", state_var),
-                            paste0("pow(y[", i - 1, "], N_", state_var, ")"),
-                            diffs.C, fixed = TRUE)
-          }
+      # IORE
+      if (state_var %in% obs_vars) {
+        if (spec[[state_var]]$type == "IORE") {
+          diffs.C <- gsub(paste0(state_var, "^N_", state_var),
+                          paste0("pow(y[", i - 1, "], N_", state_var, ")"),
+                          diffs.C, fixed = TRUE)
         }
+      }
 
-        # Replace d_... terms by f[i-1]
-        # First line
-        pattern <- paste0("^d_", state_var)
-        replacement <- paste0("\nf[", i - 1, "]")
-        diffs.C <- gsub(pattern, replacement, diffs.C)
-        # Other lines
-        pattern <- paste0("\\nd_", state_var)
-        replacement <- paste0("\nf[", i - 1, "]")
-        diffs.C <- gsub(pattern, replacement, diffs.C)
+      # Replace d_... terms by f[i-1]
+      # First line
+      pattern <- paste0("^d_", state_var)
+      replacement <- paste0("\nf[", i - 1, "]")
+      diffs.C <- gsub(pattern, replacement, diffs.C)
+      # Other lines
+      pattern <- paste0("\\nd_", state_var)
+      replacement <- paste0("\nf[", i - 1, "]")
+      diffs.C <- gsub(pattern, replacement, diffs.C)
 
-        # Replace names of observed variables by y[i],
-        # making the implicit assumption that the observed variables only occur after "* "
-        pattern <- paste0("\\* ", state_var)
-        replacement <- paste0("* y[", i - 1, "]")
-        diffs.C <- gsub(pattern, replacement, diffs.C)
-      }
+      # Replace names of observed variables by y[i],
+      # making the implicit assumption that the observed variables only occur after "* "
+      pattern <- paste0("\\* ", state_var)
+      replacement <- paste0("* y[", i - 1, "]")
+      diffs.C <- gsub(pattern, replacement, diffs.C)
+    }
 
-      derivs_sig <- signature(n = "integer", t = "numeric", y = "numeric",
-                              f = "numeric", rpar = "numeric", ipar = "integer")
+    derivs_sig <- signature(n = "integer", t = "numeric", y = "numeric",
+                            f = "numeric", rpar = "numeric", ipar = "integer")
 
-      # Declare the time variable in the body of the function if it is used
-      derivs_code <- if (spec[[1]]$type %in% c("FOMC", "DFOP", "HS")) {
-        paste0("double time = *t;\n", diffs.C)
-      } else {
-        diffs.C
-      }
+    # Declare the time variable in the body of the function if it is used
+    derivs_code <- if (spec[[1]]$type %in% c("FOMC", "DFOP", "HS")) {
+      paste0("double time = *t;\n", diffs.C)
+    } else {
+      diffs.C
+    }
 
-      # Define the function initializing the parameters
-      npar <- length(parms)
-      initpar_code <- paste0(
-        "static double parms [", npar, "];\n",
-        paste0("#define ", parms, " parms[", 0:(npar - 1), "]\n", collapse = ""),
-        "\n",
-        "void initpar(void (* odeparms)(int *, double *)) {\n",
-        "    int N = ", npar, ";\n",
-        "    odeparms(&N, parms);\n",
-        "}\n\n")
+    # Define the function initializing the parameters
+    npar <- length(parms)
+    initpar_code <- paste0(
+      "static double parms [", npar, "];\n",
+      paste0("#define ", parms, " parms[", 0:(npar - 1), "]\n", collapse = ""),
+      "\n",
+      "void initpar(void (* odeparms)(int *, double *)) {\n",
+      "    int N = ", npar, ";\n",
+      "    odeparms(&N, parms);\n",
+      "}\n\n")
 
-      # Try to build a shared library
-      cf <- try(cfunction(list(func = derivs_sig), derivs_code,
-                          otherdefs = initpar_code,
-                          verbose = verbose,
-                          convention = ".C", language = "C"),
-                silent = TRUE)
+    # Try to build a shared library
+    cf <- try(cfunction(list(func = derivs_sig), derivs_code,
+                        otherdefs = initpar_code,
+                        verbose = verbose,
+                        convention = ".C", language = "C"),
+              silent = TRUE)
 
-      if (!inherits(cf, "try-error")) {
-        if (!quiet) message("Successfully compiled differential equation model from auto-generated C code.")
-        model$cf <- cf
-      }
+    if (!inherits(cf, "try-error")) {
+      if (!quiet) message("Successfully compiled differential equation model from auto-generated C code.")
+      model$cf <- cf
     }
   }
   # }}}
diff --git a/R/plot.mmkin.R b/R/plot.mmkin.R
index 182e74ca..15ea86eb 100644
--- a/R/plot.mmkin.R
+++ b/R/plot.mmkin.R
@@ -15,6 +15,9 @@
 #' @param resplot Should the residuals plotted against time, using
 #'   \code{\link{mkinresplot}}, or as squared residuals against predicted
 #'   values, with the error model, using \code{\link{mkinerrplot}}.
+#' @param standardized Should the residuals be standardized? This option
+#'   is passed to \code{\link{mkinresplot}}, it only takes effect if 
+#'   `resplot = "time"`.
 #' @param show_errmin Should the chi2 error level be shown on top of the plots
 #'   to the left?
 #' @param errmin_var The variable for which the FOCUS chi2 error value should
@@ -51,6 +54,7 @@
 #' @export
 plot.mmkin <- function(x, main = "auto", legends = 1,
                        resplot = c("time", "errmod"),
+                       standardized = FALSE,
                        show_errmin = TRUE,
                        errmin_var = "All data", errmin_digits = 3,
                        cex = 0.7, rel.height.middle = 0.9,
@@ -136,7 +140,7 @@ plot.mmkin <- function(x, main = "auto", legends = 1,
     }
 
     if (resplot == "time") {
-      mkinresplot(fit, legend = FALSE, ...)
+      mkinresplot(fit, legend = FALSE, standardized = standardized, ...)
     } else {
       mkinerrplot(fit, legend = FALSE, ...)
     }