From 51d63256a7b3020ee11931d61b4db97b9ded02c0 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Wed, 16 Nov 2022 09:15:36 +0100 Subject: 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. --- R/saem.R | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) (limited to 'R/saem.R') diff --git a/R/saem.R b/R/saem.R index 696ea0ee..5b8021de 100644 --- a/R/saem.R +++ b/R/saem.R @@ -120,12 +120,12 @@ utils::globalVariables(c("predicted", "std")) #' summary(f_saem_dfop_sfo, data = TRUE) #' #' # The following takes about 6 minutes -#' #f_saem_dfop_sfo_deSolve <- saem(f_mmkin["DFOP-SFO", ], solution_type = "deSolve", -#' # control = list(nbiter.saemix = c(200, 80), nbdisplay = 10)) +#' f_saem_dfop_sfo_deSolve <- saem(f_mmkin["DFOP-SFO", ], solution_type = "deSolve", +#' nbiter.saemix = c(200, 80)) #' -#' #saemix::compare.saemix(list( -#' # f_saem_dfop_sfo$so, -#' # f_saem_dfop_sfo_deSolve$so)) +#' #anova( +#' # f_saem_dfop_sfo, +#' # f_saem_dfop_sfo_deSolve)) #' #' # If the model supports it, we can also use eigenvalue based solutions, which #' # take a similar amount of time @@ -580,6 +580,15 @@ saemix_model <- function(object, solution_type = "auto", transform_rates <- object[[1]]$transform_rates 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 + } + # Define the model function model_function <- function(psi, id, xidep) { @@ -613,7 +622,8 @@ saemix_model <- function(object, solution_type = "auto", odeparms = odeparms, odeini = odeini, solution_type = solution_type, outtimes = sort(unique(i_time)), - na_stop = FALSE + na_stop = FALSE, + call_lsoda = call_lsoda ) out_index <- cbind(as.character(i_time), as.character(i_name)) -- cgit v1.2.1