aboutsummaryrefslogtreecommitdiff
path: root/R/mkinfit.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2019-05-02 13:17:05 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2019-05-02 13:17:05 +0200
commit70591022c07f0e8fb4dd67789b7c8d78af8ebc18 (patch)
treeacaecfce5ae304cfc48b111c6db24a3f2ed5c83d /R/mkinfit.R
parent380a29e81f88cd80c9c6915200ddc7054c8a085a (diff)
Better initials for error model parameters
- Also make it possible to specify initial values for error model parameters. - Run tests - Rebuild docs
Diffstat (limited to 'R/mkinfit.R')
-rw-r--r--R/mkinfit.R29
1 files changed, 21 insertions, 8 deletions
diff --git a/R/mkinfit.R b/R/mkinfit.R
index 754e72b8..dca71ecf 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -21,6 +21,7 @@ if(getRversion() >= '2.15.1') utils::globalVariables(c("name", "time", "value"))
mkinfit <- function(mkinmod, observed,
parms.ini = "auto",
state.ini = "auto",
+ err.ini = "auto",
fixed_parms = NULL,
fixed_initials = names(mkinmod$diffs)[-1],
from_max_mean = FALSE,
@@ -247,6 +248,26 @@ mkinfit <- function(mkinmod, observed,
"obs" = paste0("sigma_", obs_vars),
"tc" = c("sigma_low", "rsd_high"))
+ # Define starting values for the error model
+ if (err.ini[1] != "auto") {
+ if (!identical(names(err.ini), errparm_names)) {
+ stop("Please supply initial values for error model components ", paste(errparm_names, collapse = ", "))
+ } else {
+ errparms = err.ini
+ }
+ } else {
+ if (err_mod == "const") {
+ errparms = 3
+ }
+ if (err_mod == "obs") {
+ errparms = rep(3, length(obs_vars))
+ }
+ if (err_mod == "tc") {
+ errparms <- c(sigma_low = 3, rsd_high = 0.01)
+ }
+ names(errparms) <- errparm_names
+ }
+
# Define outtimes for model solution.
# Include time points at which observed data are available
outtimes = sort(unique(c(observed$time, seq(min(observed$time),
@@ -407,14 +428,6 @@ mkinfit <- function(mkinmod, observed,
fit <- fit.ols
fit$logLik <- - nlogLik(c(fit$par, sigma = sigma_mle), OLS = FALSE)
} else {
- if (err_mod == "obs") {
- errparms = rep(3, length(obs_vars))
- }
- if (err_mod == "tc") {
- errparms <- c(sigma_low = 0.5, rsd_high = 0.07)
- }
- names(errparms) <- errparm_names
-
fit <- nlminb(c(state.ini.optim, transparms.optim, errparms),
nlogLik, control = control,
lower = lower, upper = upper, ...)

Contact - Imprint