diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/mkinerrmin.R | 29 | ||||
| -rw-r--r-- | R/mkinfit.R | 36 |
2 files changed, 37 insertions, 28 deletions
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
}
}
|