From cfa1340c41fe77117c3c2481ddbb25579f196bdd Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Mon, 30 Mar 2020 19:17:13 +0200 Subject: Don't check for gcc on the path in mkinmod Roxygen update -> formatting changes in Rd files --- R/mkinmod.R | 117 +++++++++++++++++++++++++++++------------------------------- 1 file changed, 57 insertions(+), 60 deletions(-) (limited to 'R') diff --git a/R/mkinmod.R b/R/mkinmod.R index a1ae0021..cf618525 100644 --- a/R/mkinmod.R +++ b/R/mkinmod.R @@ -364,79 +364,76 @@ 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 + # Try to create a function compiled from C code if >1 observed variable {{{ if (length(obs_vars) > 1) { - if (Sys.which("gcc") != "") { - # 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 } } # }}} -- cgit v1.2.1 From f9e0c46378f090a04fe95c70bb7977a686679895 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Tue, 31 Mar 2020 09:24:14 +0200 Subject: Static documentation rebuilt by pkgdown --- R/mkinmod.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'R') diff --git a/R/mkinmod.R b/R/mkinmod.R index cf618525..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,8 +365,9 @@ mkinmod <- function(..., use_of_ff = "min", speclist = NULL, quiet = FALSE, verb model$coefmat <- m }#}}} - # Try to create a function compiled from C code if >1 observed variable {{{ - if (length(obs_vars) > 1) { + # 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") -- cgit v1.2.1 From 64a476750ff57f4c612620bd58cc4ac42812e185 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Tue, 31 Mar 2020 09:52:19 +0200 Subject: Use inline documentation for R6 class mkinds --- R/mkinds.R | 53 +++++++++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 24 deletions(-) (limited to 'R') 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 -- cgit v1.2.1 From 47ba9ea512b82fb8b31da8ec5558f3c0952d86d4 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Thu, 2 Apr 2020 10:58:34 +0200 Subject: Compiled models article, reduce distractions - Added a section with platform specific notes on getting compiled models to work to the compiled models article - Don't return empty SFORB parameter list from endpoints() if there is no SFORB model - Avoid warnings when using standardized = TRUE in plot.mmkin() --- R/endpoints.R | 20 +++++++++++--------- R/plot.mmkin.R | 6 +++++- 2 files changed, 16 insertions(+), 10 deletions(-) (limited to 'R') 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/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, ...) } -- cgit v1.2.1