Do not introduce formation fractions for singular pathways

- As a consequence, we do not need implicit formation fractions in
  mkinfit

2 files changed, 29 insertions, 27 deletions

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)

+          }

         }

       }

     } #}}}