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/nlme.mmkin.R | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

(limited to 'R/nlme.mmkin.R')

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
-- 
cgit v1.2.1