From 759e693e9af8e794bbfa62b001117fabbdbc8bfa Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Mon, 14 Jul 2014 18:25:53 +0200
Subject: Bugfix release version 0.9-31

---
 R/mkinerrmin.R | 29 ++++++++++++++++++++---------
 R/mkinfit.R    | 36 +++++++++++++++++-------------------
 2 files changed, 37 insertions(+), 28 deletions(-)

(limited to 'R')

diff --git a/R/mkinerrmin.R b/R/mkinerrmin.R
index 671bcaab..9ebac6a4 100644
--- a/R/mkinerrmin.R
+++ b/R/mkinerrmin.R
@@ -48,6 +48,7 @@ mkinerrmin <- function(fit, alpha = 0.05)
     n.optim = errmin.overall$n.optim, df = errmin.overall$df)
   rownames(errmin) <- "All data"
 
+  # The degrees of freedom are counted according to FOCUS kinetics (2011, p. 164)
   for (obs_var in fit$obs_vars)
   {
     errdata.var <- subset(errdata, name == obs_var)
@@ -57,21 +58,31 @@ mkinerrmin <- function(fit, alpha = 0.05)
 
     # Rate constants are attributed to the source variable
     n.k.optim <- length(grep(paste("^k", obs_var, sep="_"), names(parms.optim)))
-
-    # Formation fractions are attributed to the target variable
-    n.ff.optim <- length(grep(paste("^f", ".*", obs_var, "$", sep=""), names(parms.optim)))
+    n.k.optim <- n.k.optim + length(grep(paste("^log_k", obs_var, sep="_"), 
+                                         names(parms.optim)))
+
+    n.ff.optim <- 0
+    # Formation fractions are attributed to the target variable, so look
+    # for source compartments with formation fractions
+    for (source_var in fit$obs_vars) {
+      for (target_var in fit$mkinmod$spec[[source_var]]$to) {
+        if (obs_var == target_var) {
+          n.ff.optim <- n.ff.optim +  
+                        length(grep(paste("^f", source_var, sep = "_"),
+                                    names(parms.optim))) 
+        }
+      }
+    }
 
     n.optim <- n.k.optim + n.initials.optim + n.ff.optim
 
     # FOMC, DFOP and HS parameters are only counted if we are looking at the
     # first variable in the model which is always the source variable
     if (obs_var == fit$obs_vars[[1]]) {
-      if ("alpha" %in% names(parms.optim)) n.optim <- n.optim + 1
-      if ("beta" %in% names(parms.optim)) n.optim <- n.optim + 1
-      if ("k1" %in% names(parms.optim)) n.optim <- n.optim + 1
-      if ("k2" %in% names(parms.optim)) n.optim <- n.optim + 1
-      if ("g" %in% names(parms.optim)) n.optim <- n.optim + 1
-      if ("tb" %in% names(parms.optim)) n.optim <- n.optim + 1
+      special_parms = c("alpha", "log_alpha", "beta", "log_beta", 
+                        "k1", "log_k1", "k2", "log_k2", 
+                        "g", "g_ilr", "tb", "log_tb")
+      n.optim <- n.optim + length(intersect(special_parms, names(parms.optim)))
     }
 
     # Calculate and add a line to the results
diff --git a/R/mkinfit.R b/R/mkinfit.R
index b7ca1d74..c6e13b97 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -105,26 +105,24 @@ mkinfit <- function(mkinmod, observed,
     if (parmname == "tb") parms.ini[parmname] = 5
     if (parmname == "g") parms.ini[parmname] = 0.5
   }
-  # Default values for formation fractions in case they are used
-  if (mkinmod$use_of_ff == "max") {
-    for (box in mod_vars) {
-      f_names <- mkinmod$parms[grep(paste0("^f_", box), mkinmod$parms)]
-      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.")
-        }
-        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
+  # Default values for formation fractions in case they are present
+  for (box in mod_vars) {
+    f_names <- mkinmod$parms[grep(paste0("^f_", box), mkinmod$parms)]
+    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.")
+      }
+      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
     }
   }
 
-- 
cgit v1.2.1