aboutsummaryrefslogtreecommitdiff
path: root/R/nlme.mmkin.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2023-02-17 14:44:29 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2023-02-17 14:44:29 +0100
commitd5ff53448c61134c46cc4df9ea88fd86fa376d66 (patch)
tree2332224ea61fd28e58e9e9ff07a414da59df5bff /R/nlme.mmkin.R
parent84e67cd33bc9c47ae4b111873ffe39fed910d3d4 (diff)
Finish adapting to upcoming deSolve
Diffstat (limited to 'R/nlme.mmkin.R')
-rw-r--r--R/nlme.mmkin.R22
1 files changed, 10 insertions, 12 deletions
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

Contact - Imprint