From d5ff53448c61134c46cc4df9ea88fd86fa376d66 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 17 Feb 2023 14:44:29 +0100
Subject: Finish adapting to upcoming deSolve

---
 R/mkinfit.R     |  4 ++--
 R/mkinpredict.R |  5 ++---
 R/nlme.mmkin.R  | 22 ++++++++++------------
 R/saem.R        | 12 +++++-------
 4 files changed, 19 insertions(+), 24 deletions(-)

(limited to 'R')

diff --git a/R/mkinfit.R b/R/mkinfit.R
index 6cca5616..b97bc7e2 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -617,8 +617,8 @@ mkinfit <- function(mkinmod, observed,
                          solution_type = solution_type,
                          use_compiled = use_compiled,
                          method.ode = method.ode,
-                         atol = atol, rtol = rtol,
-                         call_lsoda = call_lsoda, ...)
+                         atol = atol, rtol = rtol, 
+                         ...)
 
       observed_index <- cbind(as.character(observed$time), as.character(observed$name))
       observed$predicted <- out[observed_index]
diff --git a/R/mkinpredict.R b/R/mkinpredict.R
index f0d00319..957d5793 100644
--- a/R/mkinpredict.R
+++ b/R/mkinpredict.R
@@ -117,7 +117,6 @@ mkinpredict.mkinmod <- function(x,
   method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, maxsteps = 20000L,
   map_output = TRUE,
   na_stop = TRUE,
-  call_lsoda = NULL,
   ...)
 {
 
@@ -170,12 +169,12 @@ mkinpredict.mkinmod <- function(x,
   }
 
   if (solution_type == "deSolve") {
-    if (!is.null(x$cf) & use_compiled[1] != FALSE) {
+    if (!is.null(x$cf) & !is.null(x$symbols) & use_compiled[1] != FALSE) {
 
       out <- deSolve::lsoda(
         y = odeini,
         times = outtimes,
-        func = mkinmod[["symbols"]],
+        func = x$symbols,
         initfunc = "initpar",
         dllname = x$dll_info[["name"]],
         parms = odeparms[x$parms], # Order matters when using compiled models
diff --git a/R/nlme.mmkin.R b/R/nlme.mmkin.R
index e193e5e3..6af94455 100644
--- a/R/nlme.mmkin.R
+++ b/R/nlme.mmkin.R
@@ -149,6 +149,15 @@ nlme.mmkin <- function(model, data = "auto",
     warning("'nlme.mmkin' will redefine 'data'")
   }
 
+  # Get native symbol info for speed
+  if (model[[1]]$solution_type == "deSolve" & !is.null(model[[1]]$mkinmod$cf)) {
+    # The mkinmod stored in the first fit will be used by nlme
+    model[[1]]$mkinmod$symbols <- deSolve::checkDLL(
+      dllname = model[[1]]$mkinmod$dll_info[["name"]],
+      func = "diffs", initfunc = "initpar",
+      jacfunc = NULL, nout = 0, outnames = NULL)
+  }
+
   deg_func <- nlme_function(model)
 
   assign("deg_func", deg_func, getFromNamespace(".nlme_env", "mkin"))
@@ -186,23 +195,12 @@ nlme.mmkin <- function(model, data = "auto",
     thisCall[["control"]] <- control
   }
 
-  # Provide the address of call_lsoda to the fitting function
-  call_lsoda <- getNativeSymbolInfo("call_lsoda", PACKAGE = "deSolve")
-  if (model[[1]]$solution_type == "deSolve" & !is.null(model[[1]]$mkinmod$cf)) {
-    # The mkinmod stored in the first fit will be used by nlme
-    model[[1]]$mkinmod$diffs_address <- getNativeSymbolInfo("diffs",
-      PACKAGE = model[[1]]$mkinmod$dll_info[["name"]])$address
-    model[[1]]$mkinmod$initpar_address <- getNativeSymbolInfo("initpar",
-      PACKAGE = model[[1]]$mkinmod$dll_info[["name"]])$address
-  }
-
   fit_time <- system.time(val <- do.call("nlme.formula", thisCall))
   val$time <- fit_time
 
   val$mkinmod <- model[[1]]$mkinmod
   # Don't return addresses that will become invalid
-  val$mkinmod$diffs_address <- NULL
-  val$mkinmod$initpar_address <- NULL
+  val$mkinmod$symbols <- NULL
 
   val$data <- thisCall[["data"]]
   val$mmkin <- model
diff --git a/R/saem.R b/R/saem.R
index b29cf8a9..7eeec2bb 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -581,12 +581,11 @@ saemix_model <- function(object, solution_type = "auto",
     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
+      mkin_model$symbols <- deSolve::checkDLL(
+        dllname = mkin_model$dll_info[["name"]],
+        func = "diffs", initfunc = "initpar",
+        jacfunc = NULL, nout = 0, outnames = NULL)
     }
 
     # Define the model function
@@ -622,8 +621,7 @@ saemix_model <- function(object, solution_type = "auto",
             odeparms = odeparms, odeini = odeini,
             solution_type = solution_type,
             outtimes = sort(unique(i_time)),
-            na_stop = FALSE,
-            call_lsoda = call_lsoda
+            na_stop = FALSE
           )
 
           out_index <- cbind(as.character(i_time), as.character(i_name))
-- 
cgit v1.2.1