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

3 files changed, 53 insertions, 34 deletions

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("<mkinmod> 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,