From b36ae3d710858ee3ff2907eb2d780e0dff48a4f3 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Mon, 11 May 2020 13:43:40 +0200
Subject: Analytical solutions for all SFO variants

---
 R/create_deg_func.R | 62 ++++++++++++++++++++++++++++++++++++++++-------------
 R/mkinfit.R         |  1 +
 2 files changed, 48 insertions(+), 15 deletions(-)

(limited to 'R')

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"]
-- 
cgit v1.2.1