diff options
| author | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-16 09:15:36 +0100 |
|---|---|---|
| committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-16 09:15:36 +0100 |
| commit | 51d63256a7b3020ee11931d61b4db97b9ded02c0 (patch) | |
| tree | cb6d628211c99cb6dd1938428a18ef4dd5a997dc /R/mkinfit.R | |
| parent | 679cf716192cdfd91dfd232578cbd4e30d7eac12 (diff) | |
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.
Diffstat (limited to 'R/mkinfit.R')
| -rw-r--r-- | R/mkinfit.R | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/R/mkinfit.R b/R/mkinfit.R index 693778fd..0d9246dd 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -500,6 +500,15 @@ mkinfit <- function(mkinmod, observed, } } + # Get native symbol before iterations info for speed + call_lsoda <- getNativeSymbolInfo("call_lsoda", PACKAGE = "deSolve") + if (solution_type == "deSolve" & use_compiled[1] != FALSE) { + mkinmod$diffs_address <- getNativeSymbolInfo("diffs", + PACKAGE = mkinmod$dll_info[["name"]])$address + mkinmod$initpar_address <- getNativeSymbolInfo("initpar", + PACKAGE = mkinmod$dll_info[["name"]])$address + } + # Get the error model and the algorithm for fitting err_mod <- match.arg(error_model) error_model_algorithm = match.arg(error_model_algorithm) @@ -610,7 +619,8 @@ mkinfit <- function(mkinmod, observed, solution_type = solution_type, use_compiled = use_compiled, method.ode = method.ode, - atol = atol, rtol = rtol, ...) + atol = atol, rtol = rtol, + call_lsoda = call_lsoda, ...) observed_index <- cbind(as.character(observed$time), as.character(observed$name)) observed$predicted <- out[observed_index] @@ -892,7 +902,10 @@ mkinfit <- function(mkinmod, observed, fit$calls <- calls fit$time <- fit_time - # We also need the model and a model name for summary and plotting + # We also need the model and a model name for summary and plotting, + # but without address info that will become invalid + mkinmod$diffs_address <- NULL + mkinmod$initpar_address <- NULL fit$mkinmod <- mkinmod fit$mkinmod$name <- mkinmod_name fit$obs_vars <- obs_vars |