From 9728f72ac3fde73051c85b124d14fdc6406e6cfb Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Wed, 2 Jul 2014 18:38:39 +0200
Subject: Do not introduce formation fractions for singular pathways

- As a consequence, we do not need implicit formation fractions in
  mkinfit
---
 R/mkinfit.R | 39 ++++++++++++++++-----------------------
 R/mkinmod.R | 17 +++++++++++++----
 2 files changed, 29 insertions(+), 27 deletions(-)

(limited to 'R')

diff --git a/R/mkinfit.R b/R/mkinfit.R
index 0e643ac7..b7ca1d74 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -106,32 +106,25 @@ mkinfit <- function(mkinmod, observed,
     if (parmname == "g") parms.ini[parmname] = 0.5
   }
   # Default values for formation fractions in case they are used
-  f_fixed_implicit = numeric(0)
   if (mkinmod$use_of_ff == "max") {
     for (box in mod_vars) {
       f_names <- mkinmod$parms[grep(paste0("^f_", box), mkinmod$parms)]
-      # When we have no sink and only one pathway, we get an implicitly
-      # fixed parameter which we need in the model
-      if (!mkinmod$spec[[box]]$sink && length(f_names) == 1) {
-        if (f_names %in% names(parms.ini) && parms.ini[f_names] != 1) {
-          message("Setting ", f_names, " to 1")
-          parms.ini[f_names] = 1
+      if (length(f_names) > 0) {
+        # We need to differentiate between default and specified fractions
+        # and set the unspecified to 1 - sum(specified)/n_unspecified
+        f_default_names <- intersect(f_names, defaultpar.names)
+        f_specified_names <- setdiff(f_names, defaultpar.names)
+        sum_f_specified = sum(parms.ini[f_specified_names])
+        if (sum_f_specified > 1) {
+          stop("Starting values for the formation fractions originating from ",
+               box, " sum up to more than 1.")
         }
-        defaultpar.names <- setdiff(defaultpar.names, f_names)
-        f_fixed_implicit[f_names] = 1
-      }
-      f_default_names <- intersect(f_names, defaultpar.names)
-      f_specified_names <- setdiff(f_names, defaultpar.names)
-      sum_f_specified = sum(parms.ini[f_specified_names])
-      if (sum_f_specified > 1) {
-        stop("Starting values for the formation fractions originating from ",
-             box, " sum up to more than 1.")
-      }
-      if (mkinmod$spec[[box]]$sink) n_unspecified = length(f_default_names) + 1
-      else {
-        n_unspecified = length(f_default_names)
+        if (mkinmod$spec[[box]]$sink) n_unspecified = length(f_default_names) + 1
+        else {
+          n_unspecified = length(f_default_names)
+        }
+        parms.ini[f_default_names] <- (1 - sum_f_specified) / n_unspecified
       }
-      parms.ini[f_default_names] <- (1 - sum_f_specified) / n_unspecified
     }
   }
 
@@ -226,7 +219,7 @@ mkinfit <- function(mkinmod, observed,
                                     transform_fractions = transform_fractions)
 
     # Solve the system with current transformed parameter values
-    out <- mkinpredict(mkinmod, c(parms, f_fixed_implicit), 
+    out <- mkinpredict(mkinmod, parms, 
                        odeini, outtimes, 
                        solution_type = solution_type, 
                        method.ode = method.ode,
@@ -245,7 +238,7 @@ mkinfit <- function(mkinmod, observed,
       if(plot) {
         outtimes_plot = seq(min(observed$time), max(observed$time), length.out=100)
 
-        out_plot <- mkinpredict(mkinmod, c(parms, f_fixed_implicit),
+        out_plot <- mkinpredict(mkinmod, parms,
                                 odeini, outtimes_plot, 
                                 solution_type = solution_type, 
                                 method.ode = method.ode,
diff --git a/R/mkinmod.R b/R/mkinmod.R
index fe5e8142..1ffd14d7 100644
--- a/R/mkinmod.R
+++ b/R/mkinmod.R
@@ -150,6 +150,9 @@ mkinmod <- function(..., use_of_ff = "min", speclist = NULL)
       # Name of box from which transfer takes place
       origin_box <- box_1
 
+      # Number of targets
+      n_targets = length(to)
+
       # Add transfer terms to listed compartments
       for (target in to) {
         target_box <- switch(spec[[target]]$type,
@@ -164,10 +167,16 @@ mkinmod <- function(..., use_of_ff = "min", speclist = NULL)
           diffs[[target_box]] <- paste(diffs[[target_box]], "+", 
             k_from_to, "*", origin_box)
         } else {
-          fraction_to_target = paste("f", origin_box, "to", target, sep="_")
-          parms <- c(parms, fraction_to_target)
-          diffs[[target_box]] <- paste(diffs[[target_box]], "+", 
-              fraction_to_target, "*", decline_term)
+          # Do not introduce a formation fraction if this is the only target
+          if (spec[[origin_box]]$sink == FALSE && n_targets == 1) {
+            diffs[[target_box]] <- paste(diffs[[target_box]], "+",
+                                         decline_term)
+          } else {
+            fraction_to_target = paste("f", origin_box, "to", target, sep="_")
+            parms <- c(parms, fraction_to_target)
+            diffs[[target_box]] <- paste(diffs[[target_box]], "+", 
+                fraction_to_target, "*", decline_term)
+          }
         }
       }
     } #}}}
-- 
cgit v1.2.1