aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2020-05-11 13:43:40 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2020-05-11 13:43:40 +0200
commitb36ae3d710858ee3ff2907eb2d780e0dff48a4f3 (patch)
treeb9e075d38233106465481c25b0a777ef043fb1c7 /R
parent576fbc9d86f4db3d1be2fbd4e97b3fcd58f43c2b (diff)
Analytical solutions for all SFO variants
Diffstat (limited to 'R')
-rw-r--r--R/create_deg_func.R62
-rw-r--r--R/mkinfit.R1
2 files changed, 48 insertions, 15 deletions
diff --git a/R/create_deg_func.R b/R/create_deg_func.R
index 6c0ae40b..11559799 100644
--- a/R/create_deg_func.R
+++ b/R/create_deg_func.R
@@ -31,18 +31,27 @@ create_deg_func <- function(spec, use_of_ff = c("min", "max")) {
predicted_text <- character(0)
+ if (parent_type == "SFO") {
+ if (min_ff) {
+ targets <- c(spec[[1]]$to, if (spec[[1]]$sink) "sink" else NULL)
+ k_parent <- paste(paste0("k_", parent, "_", targets), collapse = " + ")
+ } else {
+ k_parent <- paste0("k_", parent)
+ }
+ }
+
predicted_text[parent] <- paste0(parent_type, ".solution(t, odeini['", parent,
if (parent_type == "SFORB") "_free", "'], ",
switch(parent_type,
- SFO = paste0("k_", parent, if (min_ff) "_sink" else "", ")"),
- FOMC = "alpha, beta)",
- IORE = paste0("k__iore_", parent, if (min_ff) "_sink" else "", ", N_", parent, ")"),
- DFOP = "k1, k2, g)",
- SFORB = paste0("k_", parent, "_free_bound, k_", parent, "_bound_free, k_", parent, "_free", if (min_ff) "_sink" else "", ")"),
- HS = "k1, k2, tb)",
- logistic = "kmax, k0, r)"
- )
- )
+ SFO = k_parent,
+ FOMC = "alpha, beta",
+ IORE = paste0("k__iore_", parent, if (min_ff) "_sink" else "", ", N_", parent),
+ DFOP = "k1, k2, g",
+ SFORB = paste0("k_", parent, "_free_bound, k_", parent, "_bound_free, k_", parent, "_free", if (min_ff) "_sink" else ""),
+ HS = "k1, k2, tb",
+ logistic = "kmax, k0, r"
+ ),
+ ")")
if (length(obs_vars) >= 2) {
supported <- FALSE # except for the following cases
@@ -51,20 +60,43 @@ create_deg_func <- function(spec, use_of_ff = c("min", "max")) {
n10 <- paste0("odeini['", parent, "']")
n20 <- paste0("odeini['", n2, "']")
+ # sfo_sfo
+ if (all(spec[[1]]$sink == FALSE, length(obs_vars) == 2,
+ spec[[1]]$type == "SFO", spec[[2]]$type == "SFO")) {
+ supported <- TRUE
+ k1 <- k_parent
+ k2 <- paste0("k_", n2, if(min_ff) "_sink" else "")
+ predicted_text[n2] <- paste0(
+ "(((", k2, "-", k1, ")*", n20, "-", k1, "*", n10, ")*exp(-", k2, "*t)+",
+ k1, "*", n10, "*exp(-", k1, "*t))/(", k2, "-", k1, ")")
+ }
+
+ # sfo_f12_sfo
if (all(use_of_ff == "max", spec[[1]]$sink == TRUE, length(obs_vars) == 2,
spec[[1]]$type == "SFO", spec[[2]]$type == "SFO")) {
supported <- TRUE
- k1 <- paste0("k_", n1)
+ k1 <- k_parent
k2 <- paste0("k_", n2)
f12 <- paste0("f_", n1, "_to_", n2)
- if (parent_type == "SFO") {
- predicted_text[n2] <- paste0(
- "(((", k2, "-", k1, ")*", n20, "-", f12, "*", k1, "*", n10, ")*exp(-", k2, "*t)+",
- f12, "*", k1, "*", n10, "*exp(-", k1, "*t))/(", k2, "-", k1, ")")
- }
+ predicted_text[n2] <- paste0(
+ "(((", k2, "-", k1, ")*", n20, "-", f12, "*", k1, "*", n10, ")*exp(-", k2, "*t)+",
+ f12, "*", k1, "*", n10, "*exp(-", k1, "*t))/(", k2, "-", k1, ")")
+ }
+
+ # sfo_k120_sfo
+ if (all(use_of_ff == "min", spec[[1]]$sink == TRUE, length(obs_vars) == 2,
+ spec[[1]]$type == "SFO", spec[[2]]$type == "SFO")) {
+ supported <- TRUE
+ k12 <- paste0("k_", n1, "_", n2)
+ k10 <- paste0("k_", n1, "_sink")
+ k2 <- paste0("k_", n2, "_sink")
+ predicted_text[n2] <- paste0(
+ "(((", k2, "-", k12, "-", k10, ")*", n20, "-", k12, "*", n10, ")*exp(-", k2, "*t)+",
+ k12, "*", n10, "*exp(-(", k_parent, ")*t))/(", k2, "-(", k_parent, "))")
}
}
+
if (supported) {
deg_func <- function(observed, odeini, odeparms) {}
diff --git a/R/mkinfit.R b/R/mkinfit.R
index 9c3f2baa..683a6b3d 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -297,6 +297,7 @@ mkinfit <- function(mkinmod, observed,
# This is only used for simple decline models
if (length(obs_vars) > 1)
stop("Decline from maximum is only implemented for models with a single observed variable")
+ observed$name <- as.character(observed$name)
means <- aggregate(value ~ time, data = observed, mean, na.rm=TRUE)
t_of_max <- means[which.max(means$value), "time"]

Contact - Imprint