diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2023-02-17 14:44:29 +0100 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2023-02-17 14:44:29 +0100 |
commit | d5ff53448c61134c46cc4df9ea88fd86fa376d66 (patch) | |
tree | 2332224ea61fd28e58e9e9ff07a414da59df5bff /R/nlme.mmkin.R | |
parent | 84e67cd33bc9c47ae4b111873ffe39fed910d3d4 (diff) |
Finish adapting to upcoming deSolve
Diffstat (limited to 'R/nlme.mmkin.R')
-rw-r--r-- | R/nlme.mmkin.R | 22 |
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 |