aboutsummaryrefslogtreecommitdiff
path: root/R/saem.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-03-19 10:42:07 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2022-03-19 10:42:07 +0100
commit2728910b96f0ec7dd7ccd97fc6c1f6677e5e352d (patch)
tree6b159ac1367ab23e148b98689401eaf768f620d5 /R/saem.R
parentd03a6abad27d6eef13dceb64f31b1278bb816c00 (diff)
Test saemix without special analytical solutions
Also increase the performance a bit (from about 210 s to about 140 s in the case of DFOP with four chains and 300, 100 iterations).
Diffstat (limited to 'R/saem.R')
-rw-r--r--R/saem.R32
1 files changed, 20 insertions, 12 deletions
diff --git a/R/saem.R b/R/saem.R
index d3b23861..36997ad7 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -239,10 +239,6 @@ print.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) {
saemix_model <- function(object, solution_type = "auto", transformations = c("mkin", "saemix"),
degparms_start = numeric(), test_log_parms = FALSE, conf.level = 0.6, verbose = FALSE, ...)
{
- if (packageVersion("saemix") < "3.0") {
- stop("To use the interface to saemix, you need to install a version >= 3.0\n")
- }
-
if (nrow(object) > 1) stop("Only row objects allowed")
mkin_model <- object[[1]]$mkinmod
@@ -444,9 +440,22 @@ saemix_model <- function(object, solution_type = "auto", transformations = c("mk
solution_type = "analytical saemix"
} else {
+ if (transformations == "saemix") {
+ stop("Using saemix transformations is only supported if an analytical solution is implemented for saemix")
+ }
+
if (solution_type == "auto")
solution_type <- object[[1]]$solution_type
+ # Define some variables to avoid function calls in model function
+ transparms_optim_names <- names(degparms_optim)
+ odeini_optim_names <- gsub('_0$', '', odeini_optim_parm_names)
+ diff_names <- names(mkin_model$diffs)
+ ode_transparms_optim_names <- setdiff(transparms_optim_names, odeini_optim_parm_names)
+ transform_rates <- object[[1]]$transform_rates
+ transform_fractions <- object[[1]]$transform_fractions
+
+ # Define the model function
model_function <- function(psi, id, xidep) {
uid <- unique(id)
@@ -454,22 +463,21 @@ saemix_model <- function(object, solution_type = "auto", transformations = c("mk
res_list <- lapply(uid, function(i) {
transparms_optim <- as.numeric(psi[i, ]) # psi[i, ] is a dataframe when called in saemix.predict
- names(transparms_optim) <- names(degparms_optim)
+ names(transparms_optim) <- transparms_optim_names
odeini_optim <- transparms_optim[odeini_optim_parm_names]
- names(odeini_optim) <- gsub('_0$', '', odeini_optim_parm_names)
+ names(odeini_optim) <- odeini_optim_names
- odeini <- c(odeini_optim, odeini_fixed)[names(mkin_model$diffs)]
+ odeini <- c(odeini_optim, odeini_fixed)[diff_names]
- ode_transparms_optim_names <- setdiff(names(transparms_optim), odeini_optim_parm_names)
odeparms_optim <- backtransform_odeparms(transparms_optim[ode_transparms_optim_names], mkin_model,
- transform_rates = object[[1]]$transform_rates,
- transform_fractions = object[[1]]$transform_fractions)
+ transform_rates = transform_rates,
+ transform_fractions = transform_fractions)
odeparms <- c(odeparms_optim, odeparms_fixed)
- xidep_i <- subset(xidep, id == i)
+ xidep_i <- xidep[which(id == i), ]
- if (solution_type == "analytical") {
+ if (solution_type[1] == "analytical") {
out_values <- mkin_model$deg_func(xidep_i, odeini, odeparms)
} else {

Contact - Imprint