aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2020-07-15 12:30:39 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2020-07-15 12:30:39 +0200
commit9f8e1eb33b586beb7e889212bdababa081b6ff67 (patch)
treea8ec85a113df890d6a4e3bf15001cbd0fe76abd7 /R
parent46763edbd1c9b14cff15c53d96312a7930225704 (diff)
Improve handling of (partially) failing fits
Diffstat (limited to 'R')
-rw-r--r--R/mkinfit.R46
-rw-r--r--R/mmkin.R5
2 files changed, 29 insertions, 22 deletions
diff --git a/R/mkinfit.R b/R/mkinfit.R
index 154c2a18..73fe43e0 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -712,17 +712,17 @@ mkinfit <- function(mkinmod, observed,
if (error_model_algorithm == "d_3") {
if (!quiet) message("Directly optimising the complete model")
parms.start <- c(degparms, errparms)
- fit_direct <- nlminb(parms.start, cost_function,
+ fit_direct <- try(nlminb(parms.start, cost_function,
lower = lower[names(parms.start)],
upper = upper[names(parms.start)],
- control = control, ...)
- fit_direct$logLik <- - cost.current
- if (error_model_algorithm == "direct") {
- degparms <- fit_direct$par[degparms_index]
- errparms <- fit_direct$par[errparms_index]
- } else {
+ control = control, ...))
+ if (!inherits(fit_direct, "try-error")) {
+ fit_direct$logLik <- - cost.current
cost.current <- Inf # reset to avoid conflict with the OLS step
data_direct <- current_data # We need this later if it was better
+ direct_failed = FALSE
+ } else {
+ direct_failed = TRUE
}
}
if (error_model_algorithm != "direct") {
@@ -775,24 +775,30 @@ mkinfit <- function(mkinmod, observed,
if (error_model_algorithm == "d_3") {
d_3_messages = c(
+ direct_failed = "Direct fitting failed, results of three-step fitting are returned",
same = "Direct fitting and three-step fitting yield approximately the same likelihood",
threestep = "Three-step fitting yielded a higher likelihood than direct fitting",
direct = "Direct fitting yielded a higher likelihood than three-step fitting")
- rel_diff <- abs((fit_direct$logLik - fit$logLik))/-mean(c(fit_direct$logLik, fit$logLik))
- if (rel_diff < 0.0001) {
- if (!quiet) message(d_3_messages["same"])
- fit$d_3_message <- d_3_messages["same"]
+ if (direct_failed) {
+ if (!quiet) message(d_3_messages["direct_failed"])
+ fit$d_3_message <- d_3_messages["direct_failed"]
} else {
- if (fit$logLik > fit_direct$logLik) {
- if (!quiet) message(d_3_messages["threestep"])
- fit$d_3_message <- d_3_messages["threestep"]
+ rel_diff <- abs((fit_direct$logLik - fit$logLik))/-mean(c(fit_direct$logLik, fit$logLik))
+ if (rel_diff < 0.0001) {
+ if (!quiet) message(d_3_messages["same"])
+ fit$d_3_message <- d_3_messages["same"]
} else {
- if (!quiet) message(d_3_messages["direct"])
- fit <- fit_direct
- fit$d_3_message <- d_3_messages["direct"]
- degparms <- fit$par[degparms_index]
- errparms <- fit$par[errparms_index]
- current_data <- data_direct
+ if (fit$logLik > fit_direct$logLik) {
+ if (!quiet) message(d_3_messages["threestep"])
+ fit$d_3_message <- d_3_messages["threestep"]
+ } else {
+ if (!quiet) message(d_3_messages["direct"])
+ fit <- fit_direct
+ fit$d_3_message <- d_3_messages["direct"]
+ degparms <- fit$par[degparms_index]
+ errparms <- fit$par[errparms_index]
+ current_data <- data_direct
+ }
}
}
}
diff --git a/R/mmkin.R b/R/mmkin.R
index adb9f4d0..d879fec4 100644
--- a/R/mmkin.R
+++ b/R/mmkin.R
@@ -19,8 +19,9 @@
#' @param \dots Further arguments that will be passed to \code{\link{mkinfit}}.
#' @importFrom parallel mclapply parLapply detectCores
#' @return A two-dimensional \code{\link{array}} of \code{\link{mkinfit}}
-#' objects that can be indexed using the model names for the first index (row index)
-#' and the dataset names for the second index (column index).
+#' objects and/or try-errors that can be indexed using the model names for the
+#' first index (row index) and the dataset names for the second index (column
+#' index).
#' @author Johannes Ranke
#' @seealso \code{\link{[.mmkin}} for subsetting, \code{\link{plot.mmkin}} for
#' plotting.

Contact - Imprint