We get about 25% performance gain

with the custom lsoda call, avoiding repeated getNativeSymbolInfo calls.
It's just that we should not be calling foreign functions from different
packages, because the may change without notice. Using
getNativeSymbolInfo for "call_lsoda" avoids the CRAN note, and a similar
call could probably be used for "unlock_solver", avoiding the NOTE in
checks for cran, but we should not do this in a CRAN package.

1 files changed, 16 insertions, 6 deletions

diff --git a/R/saem.R b/R/saem.R
index 696ea0ee..5b8021de 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -120,12 +120,12 @@ utils::globalVariables(c("predicted", "std"))
 #' summary(f_saem_dfop_sfo, data = TRUE)
 #'
 #' # The following takes about 6 minutes
-#' #f_saem_dfop_sfo_deSolve <- saem(f_mmkin["DFOP-SFO", ], solution_type = "deSolve",
-#' #  control = list(nbiter.saemix = c(200, 80), nbdisplay = 10))
+#' f_saem_dfop_sfo_deSolve <- saem(f_mmkin["DFOP-SFO", ], solution_type = "deSolve",
+#'   nbiter.saemix = c(200, 80))
 #'
-#' #saemix::compare.saemix(list(
-#' #  f_saem_dfop_sfo$so,
-#' #  f_saem_dfop_sfo_deSolve$so))
+#' #anova(
+#' #  f_saem_dfop_sfo,
+#' #  f_saem_dfop_sfo_deSolve))
 #'
 #' # If the model supports it, we can also use eigenvalue based solutions, which
 #' # take a similar amount of time
@@ -580,6 +580,15 @@ saemix_model <- function(object, solution_type = "auto",
     transform_rates <- object[[1]]$transform_rates
     transform_fractions <- object[[1]]$transform_fractions
 
+    # Get native symbol info for speed
+    call_lsoda <- getNativeSymbolInfo("call_lsoda", PACKAGE = "deSolve")
+    if (solution_type == "deSolve" & !is.null(mkin_model$cf)) {
+      mkin_model$diffs_address <- getNativeSymbolInfo("diffs",
+        PACKAGE = mkin_model$dll_info[["name"]])$address
+      mkin_model$initpar_address <- getNativeSymbolInfo("initpar",
+        PACKAGE = mkin_model$dll_info[["name"]])$address
+    }
+
     # Define the model function
     model_function <- function(psi, id, xidep) {
 
@@ -613,7 +622,8 @@ saemix_model <- function(object, solution_type = "auto",
             odeparms = odeparms, odeini = odeini,
             solution_type = solution_type,
             outtimes = sort(unique(i_time)),
-            na_stop = FALSE
+            na_stop = FALSE,
+            call_lsoda = call_lsoda
           )
 
           out_index <- cbind(as.character(i_time), as.character(i_name))