aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/mkinfit.R4
-rw-r--r--R/mkinpredict.R5
-rw-r--r--R/nlme.mmkin.R22
-rw-r--r--R/saem.R12
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
diff --git a/R/saem.R b/R/saem.R
index b29cf8a9..7eeec2bb 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -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))

Contact - Imprint