diff options
| author | Johannes Ranke <jranke@uni-bremen.de> | 2014-04-22 19:08:09 +0200 |
|---|---|---|
| committer | Johannes Ranke <jranke@uni-bremen.de> | 2014-04-22 19:08:09 +0200 |
| commit | a2f772990127891f9596b79771832bc23777a89a (patch) | |
| tree | 1580440d543727db6a0dbd9005936836a0e49746 /R/transform_odeparms.R | |
| parent | adcbcf246acf92c50c339a6605608a5dd9c580ff (diff) | |
Possibility to fit without parameter transformation
Diffstat (limited to 'R/transform_odeparms.R')
| -rw-r--r-- | R/transform_odeparms.R | 41 |
1 files changed, 25 insertions, 16 deletions
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)
|