From 03e1598a3c79911a497758fe382461f288bf05e6 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 16 Sep 2022 10:12:54 +0200
Subject: Diagnostic plots for multistart method

---
 R/aw.R | 36 +++++++++++++++++++++++++++++++-----
 1 file changed, 31 insertions(+), 5 deletions(-)

(limited to 'R/aw.R')

diff --git a/R/aw.R b/R/aw.R
index f46b20ec..b3992f94 100644
--- a/R/aw.R
+++ b/R/aw.R
@@ -30,6 +30,14 @@
 #' @export
 aw <- function(object, ...) UseMethod("aw")
 
+.aw <- function(all_objects) {
+  AIC_all <- sapply(all_objects, AIC)
+  delta_i <- AIC_all - min(AIC_all)
+  denom <- sum(exp(-delta_i/2))
+  w_i <- exp(-delta_i/2) / denom
+  return(w_i)
+}
+
 #' @export
 #' @rdname aw
 aw.mkinfit <- function(object, ...) {
@@ -43,11 +51,7 @@ aw.mkinfit <- function(object, ...) {
     }
   }
   all_objects <- list(object, ...)
-  AIC_all <- sapply(all_objects, AIC)
-  delta_i <- AIC_all - min(AIC_all)
-  denom <- sum(exp(-delta_i/2))
-  w_i <- exp(-delta_i/2) / denom
-  return(w_i)
+  .aw(all_objects)
 }
 
 #' @export
@@ -56,3 +60,25 @@ aw.mmkin <- function(object, ...) {
   if (ncol(object) > 1) stop("Please supply an mmkin column object")
   do.call(aw, object)
 }
+
+#' @export
+#' @rdname aw
+aw.mixed.mmkin <- function(object, ...) {
+  oo <- list(...)
+  data_object <- object$data[c("ds", "name", "time", "value")]
+  for (i in seq_along(oo)) {
+    if (!inherits(oo[[i]], "mixed.mmkin")) stop("Please supply objects inheriting from mixed.mmkin")
+    data_other_object <- oo[[i]]$data[c("ds", "name", "time", "value")]
+    if (!identical(data_object, data_other_object)) {
+      stop("It seems that the mixed.mmkin objects have not all been fitted to the same data")
+    }
+  }
+  all_objects <- list(object, ...)
+  .aw(all_objects)
+}
+
+#' @export
+#' @rdname aw
+aw.multistart <- function(object, ...) {
+  do.call(aw, object)
+}
-- 
cgit v1.2.1