From a2f772990127891f9596b79771832bc23777a89a Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Tue, 22 Apr 2014 19:08:09 +0200
Subject: Possibility to fit without parameter transformation

---
 R/transform_odeparms.R | 41 +++++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 16 deletions(-)

(limited to 'R/transform_odeparms.R')

diff --git a/R/transform_odeparms.R b/R/transform_odeparms.R
index f56478f1..31200c76 100644
--- a/R/transform_odeparms.R
+++ b/R/transform_odeparms.R
@@ -1,6 +1,4 @@
-# $Id$
-
-# Copyright (C) 2010-2013 Johannes Ranke
+# Copyright (C) 2010-2014 Johannes Ranke
 # Contact: jranke@uni-bremen.de
 
 # This file is part of the R package mkin
@@ -18,17 +16,21 @@
 # You should have received a copy of the GNU General Public License along with
 # this program. If not, see <http://www.gnu.org/licenses/>
 
-transform_odeparms <- function(parms, mod_vars) {
+transform_odeparms <- function(parms, mod_vars, 
+                               transform_rates = TRUE, 
+                               transform_fractions = TRUE) 
+{
   # Set up container for transformed parameters
   transparms <- parms
 
-  # Log transformation for rate constants
+  # Log transformation for rate constants if requested
   index_k <- grep("^k_", names(transparms))
   if (length(index_k) > 0) {
-    transparms[index_k] <- log(parms[index_k])
+    if(transform_rates) transparms[index_k] <- log(parms[index_k])
+    else transparms[index_k] <- parms[index_k]
   }
 
-  # Go through state variables and apply isotropic logratio transformation
+  # Go through state variables and apply isotropic logratio transformation if requested
   for (box in mod_vars) {
     indices_f <- grep(paste("^f", box, sep = "_"), names(parms))
     f_names <- grep(paste("^f", box, sep = "_"), names(parms), value = TRUE)
@@ -37,32 +39,38 @@ transform_odeparms <- function(parms, mod_vars) {
       f <- parms[indices_f]
       trans_f <- ilr(c(f, 1 - sum(f)))
       names(trans_f) <- f_names
-      transparms[indices_f] <- trans_f
+      if(transform_fractions) transparms[indices_f] <- trans_f
+      else transparms[indices_f] <- f
     }
   }
 
-  # Transform parameters also for FOMC, DFOP and HS models
+  # Transform parameters also for FOMC, DFOP and HS models if requested
   for (pname in c("alpha", "beta", "k1", "k2", "tb")) {
     if (!is.na(parms[pname])) {
-      transparms[pname] <- log(parms[pname])
+      transparms[pname] <- ifelse(transform_rates, log(parms[pname]), parms[pname])
+      transparms[pname] <- ifelse(transform_rates, log(parms[pname]), parms[pname])
     } 
   }
   if (!is.na(parms["g"])) {
     g <- parms["g"]
-    transparms["g"] <- ilr(c(g, 1- g))
+    transparms["g"] <- ifelse(transform_fractions, ilr(c(g, 1 - g)), g)
   }
 
   return(transparms)
 }
 
-backtransform_odeparms <- function(transparms, mod_vars) {
+backtransform_odeparms <- function(transparms, mod_vars,
+                                   transform_rates = TRUE,
+                                   transform_fractions = TRUE)
+{
   # Set up container for backtransformed parameters
   parms <- transparms
 
   # Exponential transformation for rate constants
   index_k <- grep("^k_", names(parms))
   if (length(index_k) > 0) {
-    parms[index_k] <- exp(transparms[index_k])
+    if(transform_rates) parms[index_k] <- exp(transparms[index_k])
+    else parms[index_k] <- transparms[index_k]
   }
 
   # Go through state variables and apply inverse isotropic logratio transformation
@@ -73,19 +81,20 @@ backtransform_odeparms <- function(transparms, mod_vars) {
     if (n_paths > 0) {
       f <- invilr(transparms[indices_f])[1:n_paths] # We do not need the last component
       names(f) <- f_names
-      parms[indices_f] <- f
+      if(transform_fractions) parms[indices_f] <- f
+      else parms[indices_f] <- transparms[indices_f]
     }
   }
 
   # Transform parameters also for DFOP and HS models
   for (pname in c("alpha", "beta", "k1", "k2", "tb")) {
     if (!is.na(transparms[pname])) {
-      parms[pname] <- exp(transparms[pname])
+      parms[pname] <- ifelse(transform_rates, exp(transparms[pname]), transparms[pname])
     } 
   }
   if (!is.na(transparms["g"])) {
     g <- transparms["g"]
-    parms["g"] <- invilr(g)[1]
+    parms["g"] <- ifelse(transform_fractions, invilr(g)[1], g)
   }
 
   return(parms)
-- 
cgit v1.2.1