From 503441b0a958c1df50df0ee7cfc3bde4ea1b1865 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 20 Nov 2020 19:43:46 +0100 Subject: Support storing mkinmod compiled code as CFunc objects With automatic reloading in mkinfit and mkinpredict in case the DLL is not loaded and the original DLL path has been cleaned up. Depends on jranke/inline@974bdea04fcedfafaab231e6f359c88270b56cb9 See inline#13 --- DESCRIPTION | 2 +- NAMESPACE | 3 --- R/mkinfit.R | 4 ++++ R/mkinmod.R | 66 ++++++++++++++++++++++++++++++----------------------- R/mkinpredict.R | 17 +++++++++----- man/mkinmod.Rd | 31 ++++++++++++------------- test.log | 16 ++++++------- vignettes/mkin.html | 47 ++++++++++++++++++++++++++++++++++---- 8 files changed, 120 insertions(+), 66 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 853332b1..0953d07e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,7 @@ Description: Calculation routines based on the FOCUS Kinetics Report (2006, note that no warranty is implied for correctness of results or fitness for a particular purpose. Depends: R (>= 2.15.1), parallel -Imports: stats, graphics, methods, deSolve, R6, inline, numDeriv, +Imports: stats, graphics, methods, deSolve, R6, inline (>= 0.3.17), numDeriv, lmtest, pkgbuild, nlme (>= 3.1-150.1), purrr, saemix (>= 3.1.9000) Suggests: knitr, rbenchmark, tikzDevice, testthat, rmarkdown, covr, vdiffr, benchmarkme, tibble, stats4 diff --git a/NAMESPACE b/NAMESPACE index 07fadbe9..6ff00109 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -97,14 +97,11 @@ import(graphics) import(nlme) importFrom(R6,R6Class) importFrom(grDevices,dev.cur) -importFrom(inline,cfunction) -importFrom(inline,getDynLib) importFrom(lmtest,lrtest) importFrom(methods,signature) importFrom(parallel,detectCores) importFrom(parallel,mclapply) importFrom(parallel,parLapply) -importFrom(pkgbuild,has_compiler) importFrom(purrr,map_dfr) importFrom(stats,AIC) importFrom(stats,BIC) diff --git a/R/mkinfit.R b/R/mkinfit.R index a6efc858..e482285d 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -479,6 +479,10 @@ mkinfit <- function(mkinmod, observed, solution_type = "analytical" } else { if (!is.null(mkinmod$cf) & use_compiled[1] != FALSE) { + try_dynlib <- try(inline::getDynLib(mkinmod$cf)[["path"]]) + if (inherits(try_dynlib, "try-error")) { + mkinmod$cf <- inline::readDynLib(mkinmod$cf_name, mkinmod$cf_dir) + } solution_type = "deSolve" } else { if (is.matrix(mkinmod$coefmat)) { diff --git a/R/mkinmod.R b/R/mkinmod.R index 1af72db5..434282fd 100644 --- a/R/mkinmod.R +++ b/R/mkinmod.R @@ -11,7 +11,6 @@ #' of the system of differential equations is included in the resulting #' mkinmod object in some cases, speeding up the solution. #' -#' If a C compiler is found by [pkgbuild::has_compiler()] and there #' is more than one observed variable in the specification, C code is generated #' for evaluating the differential equations, compiled using #' [inline::cfunction()] and added to the resulting mkinmod object. @@ -34,16 +33,17 @@ #' model equations and, if applicable, the coefficient matrix. If "max", #' formation fractions are always used (default). If "min", a minimum use of #' formation fractions is made, i.e. each pathway to a metabolite has its -#' own rate constant. +#' own rate constant. +#' @param name A name for the model. Should be a valid R object name. #' @param speclist The specification of the observed variables and their #' submodel types and pathways can be given as a single list using this #' argument. Default is NULL. #' @param quiet Should messages be suppressed? #' @param verbose If \code{TRUE}, passed to [inline::cfunction()] if #' applicable to give detailed information about the C function being built. +#' @param cf_dir Directory where CFunc objects should be saved. Specifying +#' 'cf_dir' without specifying a 'name' for the object is an error. #' @importFrom methods signature -#' @importFrom pkgbuild has_compiler -#' @importFrom inline cfunction #' @return A list of class \code{mkinmod} for use with [mkinfit()], #' containing, among others, #' \item{diffs}{ @@ -90,17 +90,17 @@ #' SFO_SFO <- mkinmod( #' parent = mkinsub("SFO", "m1"), #' m1 = mkinsub("SFO")) +#' print(SFO_SFO) #' #' \dontrun{ -#' # Now supplying full names used for plotting +#' fit_sfo_sfo <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve") +#' +#' # Now supplying full names used for plotting, and write to user defined location #' SFO_SFO.2 <- mkinmod( #' parent = mkinsub("SFO", "m1", full_name = "Test compound"), -#' m1 = mkinsub("SFO", full_name = "Metabolite M1")) -#' -#' # The above model used to be specified like this, before the advent of mkinsub() -#' SFO_SFO <- mkinmod( -#' parent = list(type = "SFO", to = "m1"), -#' m1 = list(type = "SFO")) +#' m1 = mkinsub("SFO", full_name = "Metabolite M1"), +#' name = "SFOSFO", cf_dir = tempdir()) +#' fit_sfo_sfo <- mkinfit(SFO_SFO.2, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve") #' #' # Show details of creating the C function #' SFO_SFO <- mkinmod( @@ -125,12 +125,18 @@ #' } #' #' @export mkinmod -mkinmod <- function(..., use_of_ff = "max", speclist = NULL, quiet = FALSE, verbose = FALSE) +mkinmod <- function(..., use_of_ff = "max", name = NULL, + speclist = NULL, quiet = FALSE, verbose = FALSE, cf_dir = NULL) { if (is.null(speclist)) spec <- list(...) else spec <- speclist obs_vars <- names(spec) + if (!is.null(cf_dir)) { + if (!dir.exists(cf_dir)) stop(cf_dir, " does not exist") + if (is.null(name)) stop("You must give a name if you want to use 'cf_dir'") + } + # Check if any of the names of the observed variables contains any other for (obs_var in obs_vars) { if (length(grep(obs_var, obs_vars)) > 1) stop("Sorry, variable names can not contain each other") @@ -372,7 +378,7 @@ mkinmod <- function(..., use_of_ff = "max", speclist = NULL, quiet = FALSE, verb # Try to create a function compiled from C code if there is more than one observed variable {{{ # and a compiler is available - if (length(obs_vars) > 1 & has_compiler()) { + if (length(obs_vars) > 1 & pkgbuild::has_compiler()) { # Translate the R code for the derivatives to C code diffs.C <- paste(diffs, collapse = ";\n") @@ -432,15 +438,27 @@ mkinmod <- function(..., use_of_ff = "max", speclist = NULL, quiet = FALSE, verb "}\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) + cf <- try(inline::cfunction(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 (is.null(cf_dir)) { + model$cf <- cf + if (!quiet) message("Temporary DLL for differentials generated and loaded") + } else { + cf_file <- inline::writeDynLib(cf, name, cf_dir) + model$cf <- inline::readDynLib(name, cf_dir) + model$cf_name <- name + model$cf_dir <- cf_dir + fileDLL <- inline::getDynLib(model$cf)[["path"]] + if (!quiet) { + message("CFunc object written to ", cf_file) + message("DLL written to ", fileDLL) + } + } } } # }}} @@ -459,14 +477,6 @@ mkinmod <- function(..., use_of_ff = "max", speclist = NULL, quiet = FALSE, verb #' #' @rdname mkinmod #' @param x An \code{\link{mkinmod}} object. -#' @examples -#' -#' 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") -#' -#' print(m_synth_SFO_lin) -#' #' @export print.mkinmod <- function(x, ...) { cat(" model generated with\n") diff --git a/R/mkinpredict.R b/R/mkinpredict.R index 7222e247..a294a114 100644 --- a/R/mkinpredict.R +++ b/R/mkinpredict.R @@ -38,7 +38,6 @@ #' @param \dots Further arguments passed to the ode solver in case such a #' solver is used. #' @import deSolve -#' @importFrom inline getDynLib #' @return A matrix with the numeric solution in wide format #' @author Johannes Ranke #' @examples @@ -117,7 +116,7 @@ mkinpredict.mkinmod <- function(x, solution_type = "deSolve", use_compiled = "auto", method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, - map_output = TRUE, + map_output = TRUE, na_stop = TRUE, ...) { @@ -170,12 +169,18 @@ mkinpredict.mkinmod <- function(x, if (solution_type == "deSolve") { if (!is.null(x$cf) & use_compiled[1] != FALSE) { - out <- ode( + DLL <- try(inline::getDynLib(x$cf)) + if (inherits(DLL, "try-error")) { + x$cf <- inline::readDynLib(x$cf_name, x$cf_dir) + } + cf_env <- environment(x$cf) + + out <- deSolve::ode( y = odeini, times = outtimes, - func = "func", + func = cf_env$name, initfunc = "initpar", - dllname = getDynLib(x$cf)[["name"]], + dllname = cf_env$f, parms = odeparms[x$parms], # Order matters when using compiled models method = method.ode, atol = atol, @@ -195,7 +200,7 @@ mkinpredict.mkinmod <- function(x, } return(list(c(diffs))) } - out <- ode( + out <- deSolve::ode( y = odeini, times = outtimes, func = mkindiff, diff --git a/man/mkinmod.Rd b/man/mkinmod.Rd index e5b1c8f3..f71ebfb3 100644 --- a/man/mkinmod.Rd +++ b/man/mkinmod.Rd @@ -9,9 +9,11 @@ mkinmod( ..., use_of_ff = "max", + name = NULL, speclist = NULL, quiet = FALSE, - verbose = FALSE + verbose = FALSE, + cf_dir = NULL ) \method{print}{mkinmod}(x, ...) @@ -40,6 +42,8 @@ formation fractions are always used (default). If "min", a minimum use of formation fractions is made, i.e. each pathway to a metabolite has its own rate constant.} +\item{name}{A name for the model. Should be a valid R object name.} + \item{speclist}{The specification of the observed variables and their submodel types and pathways can be given as a single list using this argument. Default is NULL.} @@ -49,6 +53,9 @@ argument. Default is NULL.} \item{verbose}{If \code{TRUE}, passed to \code{\link[inline:cfunction]{inline::cfunction()}} if applicable to give detailed information about the C function being built.} +\item{cf_dir}{Directory where CFunc objects should be saved. Specifying +'cf_dir' without specifying a 'name' for the object is an error.} + \item{x}{An \code{\link{mkinmod}} object.} \item{submodel}{Character vector of length one to specify the submodel type. @@ -113,7 +120,6 @@ For kinetic models with more than one observed variable, a symbolic solution of the system of differential equations is included in the resulting mkinmod object in some cases, speeding up the solution. -If a C compiler is found by \code{\link[pkgbuild:has_compiler]{pkgbuild::has_compiler()}} and there is more than one observed variable in the specification, C code is generated for evaluating the differential equations, compiled using \code{\link[inline:cfunction]{inline::cfunction()}} and added to the resulting mkinmod object. @@ -132,17 +138,17 @@ SFO <- mkinmod(parent = mkinsub("SFO")) SFO_SFO <- mkinmod( parent = mkinsub("SFO", "m1"), m1 = mkinsub("SFO")) +print(SFO_SFO) \dontrun{ -# Now supplying full names used for plotting + fit_sfo_sfo <- mkinfit(SFO_SFO, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve") + + # Now supplying full names used for plotting, and write to user defined location SFO_SFO.2 <- mkinmod( parent = mkinsub("SFO", "m1", full_name = "Test compound"), - m1 = mkinsub("SFO", full_name = "Metabolite M1")) - -# The above model used to be specified like this, before the advent of mkinsub() -SFO_SFO <- mkinmod( - parent = list(type = "SFO", to = "m1"), - m1 = list(type = "SFO")) + m1 = mkinsub("SFO", full_name = "Metabolite M1"), + name = "SFOSFO", cf_dir = tempdir()) +fit_sfo_sfo <- mkinfit(SFO_SFO.2, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve") # Show details of creating the C function SFO_SFO <- mkinmod( @@ -166,13 +172,6 @@ fit_DFOP_par_c <- mkinfit(m_synth_DFOP_par, quiet = TRUE) } - - 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") - - print(m_synth_SFO_lin) - } \references{ FOCUS (2006) \dQuote{Guidance Document on Estimating Persistence diff --git a/test.log b/test.log index 957a3e87..844c7542 100644 --- a/test.log +++ b/test.log @@ -6,17 +6,17 @@ Testing mkin ✔ | 2 | Export dataset for reading into CAKE ✔ | 14 | Results for FOCUS D established in expertise for UBA (Ranke 2014) [0.9 s] ✔ | 4 | Calculation of FOCUS chi2 error levels [0.4 s] -✔ | 7 | Fitting the SFORB model [3.5 s] +✔ | 7 | Fitting the SFORB model [3.4 s] ✔ | 5 | Analytical solutions for coupled models [3.1 s] ✔ | 5 | Calculation of Akaike weights ✔ | 10 | Confidence intervals and p-values [1.0 s] -✔ | 14 | Error model fitting [4.6 s] +✔ | 14 | Error model fitting [4.3 s] ✔ | 4 | Test fitting the decline of metabolites from their maximum [0.3 s] ✔ | 1 | Fitting the logistic model [0.2 s] ✔ | 1 | Test dataset class mkinds used in gmkin ✔ | 1 | mkinfit features [0.3 s] ✔ | 12 | Special cases of mkinfit calls [0.7 s] -✔ | 8 | mkinmod model generation and printing [0.3 s] +✔ | 8 | mkinmod model generation and printing [0.2 s] ✔ | 3 | Model predictions with mkinpredict [0.4 s] ✔ | 14 2 | Evaluations according to 2015 NAFTA guidance [1.2 s] ──────────────────────────────────────────────────────────────────────────────── @@ -26,22 +26,22 @@ Reason: getRversion() < "4.1.0" is TRUE Skip (test_nafta.R:55:5): Test data from Appendix D are correctly evaluated Reason: getRversion() < "4.1.0" is TRUE ──────────────────────────────────────────────────────────────────────────────── -✔ | 9 | Nonlinear mixed-effects models [8.2 s] +✔ | 9 | Nonlinear mixed-effects models [7.8 s] ✔ | 0 1 | Plotting [0.7 s] ──────────────────────────────────────────────────────────────────────────────── Skip (test_plot.R:25:3): Plotting mkinfit and mmkin objects is reproducible Reason: getRversion() < "4.1.0" is TRUE ──────────────────────────────────────────────────────────────────────────────── ✔ | 4 | Residuals extracted from mkinfit models -✔ | 2 | Complex test case from Schaefer et al. (2007) Piacenza paper [1.6 s] +✔ | 2 | Complex test case from Schaefer et al. (2007) Piacenza paper [1.5 s] ✔ | 4 | Summary [0.1 s] ✔ | 1 | Summaries of old mkinfit objects -✔ | 4 | Results for synthetic data established in expertise for UBA (Ranke 2014) [2.3 s] -✔ | 9 | Hypothesis tests [7.2 s] +✔ | 4 | Results for synthetic data established in expertise for UBA (Ranke 2014) [2.2 s] +✔ | 9 | Hypothesis tests [7.1 s] ✔ | 4 | Calculation of maximum time weighted average concentrations (TWAs) [2.4 s] ══ Results ═════════════════════════════════════════════════════════════════════ -Duration: 39.5 s +Duration: 38.5 s ── Skipped tests ────────────────────────────────────────────────────────────── ● getRversion() < "4.1.0" is TRUE (3) diff --git a/vignettes/mkin.html b/vignettes/mkin.html index 26de3deb..43481d8f 100644 --- a/vignettes/mkin.html +++ b/vignettes/mkin.html @@ -11,7 +11,7 @@ - + Introduction to mkin @@ -1343,6 +1343,45 @@ color: #d14; } + + +