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 --- R/mkinfit.R | 4 ++++ R/mkinmod.R | 66 +++++++++++++++++++++++++++++++++------------------------ R/mkinpredict.R | 17 +++++++++------ 3 files changed, 53 insertions(+), 34 deletions(-) (limited to 'R') 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, -- cgit v1.2.1 From 1e3fd1bef2a0ec1c8b73fcfefdd62fd3463bc87c Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 27 Nov 2020 18:35:56 +0100 Subject: Improved way to have persistent DLLs for mkinmod Depends on inline >= 0.16.2 (including the bug fixes from eddelbuettel/inline#18), which provides 'moveDLL' to store the DLL for a compiled function in a safe place in case the argument 'dll_dir' is specified in the call to 'mkinmod'. Huge thanks to Dirk @eddelbuettel for his review and support for the work on the inline package. --- R/mkinfit.R | 4 ---- R/mkinmod.R | 60 +++++++++++++++++++++++++++++++++------------------------ R/mkinpredict.R | 9 ++------- 3 files changed, 37 insertions(+), 36 deletions(-) (limited to 'R') diff --git a/R/mkinfit.R b/R/mkinfit.R index e482285d..a6efc858 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -479,10 +479,6 @@ 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 434282fd..a7353e81 100644 --- a/R/mkinmod.R +++ b/R/mkinmod.R @@ -11,6 +11,7 @@ #' 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,15 +35,21 @@ #' 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. -#' @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. +#' @param name A name for the model. Should be a valid R object name. +#' @param dll_dir Directory where an DLL object, if generated internally by +#' [inline::cfunction()], should be saved. The DLL will only be stored in a +#' permanent location for use in future sessions, if 'dll_dir' and 'name' +#' are specified. +#' @param unload If a DLL from the target location in 'dll_dir' is already +#' loaded, should that be unloaded first? +#' @param overwrite If a file exists at the target DLL location in 'dll_dir', +#' should this be overwritten? #' @importFrom methods signature #' @return A list of class \code{mkinmod} for use with [mkinfit()], #' containing, among others, @@ -95,12 +102,20 @@ #' \dontrun{ #' 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 +#' # Now supplying compound names used for plotting, and write to user defined location +#' # We need to choose a path outside the session tempdir because this gets removed +#' DLL_dir <- "~/.local/share/mkin" +#' if (!dir.exists(DLL_dir)) dir.create(DLL_dir) #' SFO_SFO.2 <- mkinmod( #' parent = mkinsub("SFO", "m1", full_name = "Test compound"), #' 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") +#' name = "SFO_SFO", dll_dir = DLL_dir, unload = TRUE, overwrite = TRUE) +#' # Now we can save the model and restore it in a new session +#' saveRDS(SFO_SFO.2, file = "~/SFO_SFO.rds") +#' # Terminate the R session here if you would like to check, and then do +#' library(mkin) +#' SFO_SFO.3 <- readRDS("~/SFO_SFO.rds") +#' fit_sfo_sfo <- mkinfit(SFO_SFO.3, FOCUS_2006_D, quiet = TRUE, solution_type = "deSolve") #' #' # Show details of creating the C function #' SFO_SFO <- mkinmod( @@ -126,15 +141,17 @@ #' #' @export mkinmod mkinmod <- function(..., use_of_ff = "max", name = NULL, - speclist = NULL, quiet = FALSE, verbose = FALSE, cf_dir = NULL) + speclist = NULL, quiet = FALSE, verbose = FALSE, dll_dir = NULL, + unload = FALSE, overwrite = FALSE) { 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'") + save_msg <- "You need to specify both 'name' and 'dll_dir' to save a model DLL" + if (!is.null(dll_dir)) { + if (!dir.exists(dll_dir)) stop(dll_dir, " does not exist") + if (is.null(name)) stop(save_msg) } # Check if any of the names of the observed variables contains any other @@ -310,7 +327,7 @@ mkinmod <- function(..., use_of_ff = "max", name = NULL, } #}}} } #}}} - model <- list(diffs = diffs, parms = parms, map = map, spec = spec, use_of_ff = use_of_ff) + model <- list(diffs = diffs, parms = parms, map = map, spec = spec, use_of_ff = use_of_ff, name = name) # Create coefficient matrix if possible #{{{ if (mat) { @@ -438,26 +455,19 @@ mkinmod <- function(..., use_of_ff = "max", name = NULL, "}\n\n") # Try to build a shared library - cf <- try(inline::cfunction(derivs_sig, derivs_code, + model$cf <- try(inline::cfunction(derivs_sig, derivs_code, otherdefs = initpar_code, - verbose = verbose, + verbose = verbose, name = "diffs", convention = ".C", language = "C"), silent = TRUE) - if (!inherits(cf, "try-error")) { - if (is.null(cf_dir)) { - model$cf <- cf + if (!inherits(model$cf, "try-error")) { + if (is.null(dll_dir)) { if (!quiet) message("Temporary DLL for differentials generated and loaded") + dll_info <- inline::getDynLib(model$cf) } 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) - } + dll_info <- inline::moveDLL(model$cf, name, dll_dir, + unload = unload, overwrite = overwrite, verbose = !quiet) } } } diff --git a/R/mkinpredict.R b/R/mkinpredict.R index a294a114..277c3604 100644 --- a/R/mkinpredict.R +++ b/R/mkinpredict.R @@ -169,18 +169,13 @@ mkinpredict.mkinmod <- function(x, if (solution_type == "deSolve") { if (!is.null(x$cf) & use_compiled[1] != FALSE) { - 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 = cf_env$name, + func = "diffs", initfunc = "initpar", - dllname = cf_env$f, + dllname = inline::getDynLib(x$cf)[["name"]], parms = odeparms[x$parms], # Order matters when using compiled models method = method.ode, atol = atol, -- cgit v1.2.1