1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
transform_odeparms <- function(parms, mod_vars) {
# Set up container for transformed parameters
transparms <- parms
# Log transformation for rate constants
index_k <- grep("^k_", names(transparms))
if (length(index_k) > 0) {
transparms[index_k] <- log(parms[index_k])
}
# Go through state variables and apply isotropic logratio transformation
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)
n_paths <- length(indices_f)
if (n_paths > 0) {
f <- parms[indices_f]
trans_f <- ilr(c(f, 1 - sum(f)))
names(trans_f) <- f_names
transparms[indices_f] <- trans_f
}
}
# Transform parameters also for FOMC, DFOP and HS models
for (pname in c("alpha", "beta", "k1", "k2", "tb")) {
if (!is.na(parms[pname])) {
transparms[pname] <- log(parms[pname])
}
}
if (!is.na(parms["g"])) {
g <- parms["g"]
transparms["g"] <- ilr(c(g, 1- g))
}
return(transparms)
}
backtransform_odeparms <- function(transparms, mod_vars) {
# 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])
}
# Go through state variables and apply inverse isotropic logratio transformation
for (box in mod_vars) {
indices_f <- grep(paste("^f", box, sep = "_"), names(transparms))
f_names <- grep(paste("^f", box, sep = "_"), names(transparms), value = TRUE)
n_paths <- length(indices_f)
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
}
}
# 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])
}
}
if (!is.na(transparms["g"])) {
g <- transparms["g"]
parms["g"] <- invilr(g)[1]
}
return(parms)
}
|
