R/sensitivity.R

In ERRI: Economic Resilience and Recovery Index

#' Weight-sensitivity analysis for ERRI
#'
#' Generates random weights uniformly on the simplex and recalculates the
#' index and rank of each unit.
#'
#' @param object An `erri` object.
#' @param R Number of random weight vectors.
#' @param seed Optional integer seed.
#' @return A data frame with sampled weights, indices, and ranks.
#' @export
#' @examples
#' fit <- erri(erri_example_data(), "year", "income", 2020, "region")
#' sens <- erri_sensitivity(fit, R = 100, seed = 3)
#' head(sens)
erri_sensitivity <- function(object, R = 1000L, seed = NULL) {
    if (!inherits(object, "erri")) .erri_stop("'object' must inherit from 'erri'.")
    R <- as.integer(R)
    if (is.na(R) || R < 1L) .erri_stop("'R' must be positive.")
    if (!is.null(seed)) set.seed(seed)
    score_names <- paste0(names(object$weights), "_score")
    scores <- as.matrix(object$results[score_names]) / 100
    ans <- vector("list", R)
    for (b in seq_len(R)) {
        w <- -log(stats::runif(length(object$weights)))
        w <- w / sum(w)
        idx <- 100 * as.numeric(scores %*% w)
        ans[[b]] <- data.frame(replication = b, unit = object$results$unit,
                               ERRI = idx, rank = rank(-idx, ties.method = "average"),
                               matrix(rep(w, each = nrow(scores)), nrow = nrow(scores),
                                      dimnames = list(NULL, paste0("w_", names(object$weights)))),
                               check.names = FALSE, stringsAsFactors = FALSE)
    }
    do.call(rbind, ans)
}