diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/mkinfit.R | 4 | ||||
| -rw-r--r-- | R/mkinpredict.R | 5 | ||||
| -rw-r--r-- | R/nlme.mmkin.R | 22 | ||||
| -rw-r--r-- | R/saem.R | 12 |
4 files changed, 19 insertions, 24 deletions
diff --git a/R/mkinfit.R b/R/mkinfit.R index 6cca5616..b97bc7e2 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -617,8 +617,8 @@ mkinfit <- function(mkinmod, observed, solution_type = solution_type, use_compiled = use_compiled, method.ode = method.ode, - atol = atol, rtol = rtol, - call_lsoda = call_lsoda, ...) + atol = atol, rtol = rtol, + ...) observed_index <- cbind(as.character(observed$time), as.character(observed$name)) observed$predicted <- out[observed_index] diff --git a/R/mkinpredict.R b/R/mkinpredict.R index f0d00319..957d5793 100644 --- a/R/mkinpredict.R +++ b/R/mkinpredict.R @@ -117,7 +117,6 @@ mkinpredict.mkinmod <- function(x, method.ode = "lsoda", atol = 1e-8, rtol = 1e-10, maxsteps = 20000L, map_output = TRUE, na_stop = TRUE, - call_lsoda = NULL, ...) { @@ -170,12 +169,12 @@ mkinpredict.mkinmod <- function(x, } if (solution_type == "deSolve") { - if (!is.null(x$cf) & use_compiled[1] != FALSE) { + if (!is.null(x$cf) & !is.null(x$symbols) & use_compiled[1] != FALSE) { out <- deSolve::lsoda( y = odeini, times = outtimes, - func = mkinmod[["symbols"]], + func = x$symbols, initfunc = "initpar", dllname = x$dll_info[["name"]], parms = odeparms[x$parms], # Order matters when using compiled models 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 @@ -581,12 +581,11 @@ saemix_model <- function(object, solution_type = "auto", 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 + mkin_model$symbols <- deSolve::checkDLL( + dllname = mkin_model$dll_info[["name"]], + func = "diffs", initfunc = "initpar", + jacfunc = NULL, nout = 0, outnames = NULL) } # Define the model function @@ -622,8 +621,7 @@ saemix_model <- function(object, solution_type = "auto", odeparms = odeparms, odeini = odeini, solution_type = solution_type, outtimes = sort(unique(i_time)), - na_stop = FALSE, - call_lsoda = call_lsoda + na_stop = FALSE ) out_index <- cbind(as.character(i_time), as.character(i_name)) |