From 6168089ac43664c10ca2dc1281c8648fbf3b35a9 Mon Sep 17 00:00:00 2001
From: jranke <jranke@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Date: Sun, 14 Apr 2013 12:42:06 +0000
Subject: - Update the TODO list, setting some requirements for version 1.0 -
 Check that initial values specified using parms.ini are actually needed for
 the model, stop otherwise - List all formation fractions in the same place in
 the summary, also if they were fitted in the model - Include an FOMC model
 coupled to two metabolites in the unit tests - Some updates needed because of
 the above - Update of static documentation including the vignettes - Update
 of the mkin vignettes in the vignettes directory

git-svn-id: svn+ssh://svn.r-forge.r-project.org/svnroot/kinfit/pkg/mkin@82 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
---
 R/endpoints.R | 14 ++++++++++++++
 R/mkinfit.R   | 14 ++++++++++++--
 R/mkinmod.R   |  1 +
 3 files changed, 27 insertions(+), 2 deletions(-)

(limited to 'R')

diff --git a/R/endpoints.R b/R/endpoints.R
index 163dc8d..c9a6a51 100644
--- a/R/endpoints.R
+++ b/R/endpoints.R
@@ -11,6 +11,20 @@ endpoints <- function(fit, pseudoDT50 = FALSE) {
   ep$SFORB <- vector()
   for (obs_var in obs_vars) {
     type = names(fit$mkinmod$map[[obs_var]])[1]  
+
+    # Get formation fractions if directly fitted, and calculate remaining fraction to sink
+    f_names = grep(paste("f", obs_var, sep = "_"), names(parms.all), value=TRUE)
+    f_values = parms.all[f_names]
+    f_to_sink = 1 - sum(f_values)
+    names(f_to_sink) = ifelse(type == "SFORB", 
+                            paste(obs_var, "free", "sink", sep = "_"), 
+                            paste(obs_var, "sink", sep = "_"))
+    for (f_name in f_names) {
+      ep$ff[[sub("f_", "", sub("_to_", "_", f_name))]] = f_values[[f_name]]
+    }
+    ep$ff = append(ep$ff, f_to_sink)
+
+    # Get the rest
     if (type == "SFO") {
       k_names = grep(paste("k", obs_var, sep="_"), names(parms.all), value=TRUE)
       k_tot = sum(parms.all[k_names])
diff --git a/R/mkinfit.R b/R/mkinfit.R
index b80be97..cf018f0 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -28,6 +28,8 @@ mkinfit <- function(mkinmod, observed,
   fixed_parms = NULL,
   fixed_initials = names(mkinmod$diffs)[-1],
   solution_type = "auto",
+  method.modFit = "Marq",
+  control.modFit = list(),
   plot = FALSE, quiet = FALSE,
   err = NULL, weight = "none", scaleVar = FALSE,
   atol = 1e-8, rtol = 1e-10, n.outtimes = 100,
@@ -45,6 +47,13 @@ mkinfit <- function(mkinmod, observed,
 
   # Define starting values for parameters where not specified by the user
   if (parms.ini[[1]] == "auto") parms.ini = vector()
+
+  # Prevent inital parameter specifications that are not in the model
+  wrongpar.names <- setdiff(names(parms.ini), mkinmod$parms)
+  if (length(wrongpar.names) > 0) {
+    stop("Initial parameter(s) ", paste(wrongpar.names, collapse = ", "), " not used in the model")
+  }
+
   defaultpar.names <- setdiff(mkinmod$parms, names(parms.ini))
   for (parmname in defaultpar.names) {
     # Default values for rate constants, depending on the parameterisation
@@ -168,7 +177,7 @@ mkinfit <- function(mkinmod, observed,
     }
     return(mC)
   }
-  fit <- modFit(cost, c(state.ini.optim, parms.optim), ...)
+  fit <- modFit(cost, c(state.ini.optim, parms.optim), method = method.modFit, control = control.modFit, ...)
 
   # We need to return some more data for summary and plotting
   fit$solution_type <- solution_type
@@ -203,6 +212,7 @@ mkinfit <- function(mkinmod, observed,
   fit$data <- data[order(data$variable, data$time), ]
   fit$atol <- atol
   fit$rtol <- rtol
+
   # Return all backtransformed parameters for summary
   fit$bparms.optim <- bparms.optim 
   fit$bparms.fixed <- bparms.fixed
@@ -239,7 +249,7 @@ summary.mkinfit <- function(object, data = TRUE, distimes = TRUE, alpha = 0.05,
   dimnames(param) <- list(pnames, c("Estimate", "Std. Error", "Lower", "Upper"))
 
   blci <- buci <- numeric()
-  # Only use lower end of CI for one parameter at a time
+  # Only transform boundaries of CI for one parameter at a time
   for (pname in pnames) {
     par.lower <- par.upper <- object$par
     par.lower[pname] <- param[pname, "Lower"]
diff --git a/R/mkinmod.R b/R/mkinmod.R
index adfd9ea..09deea4 100644
--- a/R/mkinmod.R
+++ b/R/mkinmod.R
@@ -26,6 +26,7 @@ mkinmod <- function(..., use_of_ff = "min")
   # Check if any of the names of the observed variables contains any other
   for (obs_var in obs_vars) {
     if (length(grep(obs_var, obs_vars)) > 1) stop("Sorry, variable names can not contain each other")
+    if (grepl("_to_", obs_var)) stop("Sorry, names of observed variables can not contain _to_")
   }
 
   if (!use_of_ff %in% c("min", "max"))
-- 
cgit v1.2.1