aboutsummaryrefslogtreecommitdiff
path: root/R/aw.R
diff options
context:
space:
mode:
Diffstat (limited to 'R/aw.R')
-rw-r--r--R/aw.R58
1 files changed, 58 insertions, 0 deletions
diff --git a/R/aw.R b/R/aw.R
new file mode 100644
index 00000000..f46b20ec
--- /dev/null
+++ b/R/aw.R
@@ -0,0 +1,58 @@
+#' Calculate Akaike weights for model averaging
+#'
+#' Akaike weights are calculated based on the relative
+#' expected Kullback-Leibler information as specified
+#' by Burnham and Anderson (2004).
+#'
+#' @param object An [mmkin] column object, containing two or more
+#' [mkinfit] models that have been fitted to the same data,
+#' or an mkinfit object. In the latter case, further mkinfit
+#' objects fitted to the same data should be specified
+#' as dots arguments.
+#' @param \dots Not used in the method for [mmkin] column objects,
+#' further [mkinfit] objects in the method for mkinfit objects.
+#' @references Burnham KP and Anderson DR (2004) Multimodel
+#' Inference: Understanding AIC and BIC in Model Selection.
+#' *Sociological Methods & Research* **33**(2) 261-304
+#' @md
+#' @examples
+#' \dontrun{
+#' f_sfo <- mkinfit("SFO", FOCUS_2006_D, quiet = TRUE)
+#' f_dfop <- mkinfit("DFOP", FOCUS_2006_D, quiet = TRUE)
+#' aw_sfo_dfop <- aw(f_sfo, f_dfop)
+#' sum(aw_sfo_dfop)
+#' aw_sfo_dfop # SFO gets more weight as it has less parameters and a similar fit
+#' f <- mmkin(c("SFO", "FOMC", "DFOP"), list("FOCUS D" = FOCUS_2006_D), cores = 1, quiet = TRUE)
+#' aw(f)
+#' sum(aw(f))
+#' aw(f[c("SFO", "DFOP")])
+#' }
+#' @export
+aw <- function(object, ...) UseMethod("aw")
+
+#' @export
+#' @rdname aw
+aw.mkinfit <- function(object, ...) {
+ oo <- list(...)
+ data_object <- object$data[c("time", "variable", "observed")]
+ for (i in seq_along(oo)) {
+ if (!inherits(oo[[i]], "mkinfit")) stop("Please supply only mkinfit objects")
+ data_other_object <- oo[[i]]$data[c("time", "variable", "observed")]
+ if (!identical(data_object, data_other_object)) {
+ stop("It seems that the mkinfit objects have not all been fitted to the same data")
+ }
+ }
+ 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)
+}
+
+#' @export
+#' @rdname aw
+aw.mmkin <- function(object, ...) {
+ if (ncol(object) > 1) stop("Please supply an mmkin column object")
+ do.call(aw, object)
+}

Contact - Imprint