aboutsummaryrefslogtreecommitdiff
path: root/R/saem.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-17 10:28:54 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-17 10:28:54 +0200
commitb848fb360aa865c37298ee7526344b5280c700cc (patch)
treef1403f49672e01baf5f6b6475db6a383b0d60bee /R/saem.R
parentc03fa5d4e57033869cb437c1154da31abd96fc50 (diff)
SFORB in saem, update for mhmkin and multistart
Diffstat (limited to 'R/saem.R')
-rw-r--r--R/saem.R37
1 files changed, 36 insertions, 1 deletions
diff --git a/R/saem.R b/R/saem.R
index 5256f6b5..dbc19dec 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -313,7 +313,7 @@ saemix_model <- function(object, solution_type = "auto",
# Parent only
if (length(mkin_model$spec) == 1) {
parent_type <- mkin_model$spec[[1]]$type
- if (length(odeini_fixed) == 1) {
+ if (length(odeini_fixed) == 1 && !grepl("_bound$", names(odeini_fixed))) {
if (transformations == "saemix") {
stop("saemix transformations are not supported for parent fits with fixed initial parent value")
}
@@ -344,6 +344,9 @@ saemix_model <- function(object, solution_type = "auto",
}
}
} else {
+ if (length(odeini_fixed) == 2) {
+ stop("SFORB with fixed initial parent value is not supported")
+ }
if (parent_type == "SFO") {
if (transformations == "mkin") {
model_function <- function(psi, id, xidep) {
@@ -386,6 +389,38 @@ saemix_model <- function(object, solution_type = "auto",
transform.par = c(0, 1, 1, 3)
}
}
+ if (parent_type == "SFORB") {
+ if (transformations == "mkin") {
+ model_function <- function(psi, id, xidep) {
+ k_12 <- exp(psi[id, 3])
+ k_21 <- exp(psi[id, 4])
+ k_1output <- exp(psi[id, 2])
+ t <- xidep[, "time"]
+
+ sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 + k_12 * k_21 - (k_12 + k_1output) * k_21)
+ b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp
+ b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp
+
+ psi[id, 1] * (((k_12 + k_21 - b1)/(b2 - b1)) * exp(-b1 * t) +
+ ((k_12 + k_21 - b2)/(b1 - b2)) * exp(-b2 * t))
+ }
+ } else {
+ model_function <- function(psi, id, xidep) {
+ k_12 <- psi[id, 3]
+ k_21 <- psi[id, 4]
+ k_1output <- psi[id, 2]
+ t <- xidep[, "time"]
+
+ sqrt_exp = sqrt(1/4 * (k_12 + k_21 + k_1output)^2 + k_12 * k_21 - (k_12 + k_1output) * k_21)
+ b1 = 0.5 * (k_12 + k_21 + k_1output) + sqrt_exp
+ b2 = 0.5 * (k_12 + k_21 + k_1output) - sqrt_exp
+
+ psi[id, 1] * (((k_12 + k_21 - b1)/(b2 - b1)) * exp(-b1 * t) +
+ ((k_12 + k_21 - b2)/(b1 - b2)) * exp(-b2 * t))
+ }
+ transform.par = c(0, 1, 1, 1)
+ }
+ }
if (parent_type == "HS") {
if (transformations == "mkin") {
model_function <- function(psi, id, xidep) {

Contact - Imprint