R/plot.R

In ERRI: Economic Resilience and Recovery Index

#' Plot an ERRI trajectory or index comparison
#'
#' @param x An object returned by [erri()].
#' @param type `"trajectory"`, `"index"`, or `"components"`.
#' @param unit Unit to display for a trajectory. Defaults to the first unit.
#' @param ... Additional arguments passed to the base plotting function.
#' @return The object invisibly.
#' @export
#' @examples
#' fit <- erri(erri_example_data(), "year", "income", 2020, "region")
#' plot(fit, type = "index")
plot.erri <- function(x, type = c("trajectory", "index", "components"),
                      unit = NULL, ...) {
    type <- match.arg(type)
    if (type == "trajectory") {
        if (is.null(unit)) unit <- names(x$trajectories)[1L]
        if (!unit %in% names(x$trajectories)) .erri_stop("Unknown unit: ", unit)
        d <- x$trajectories[[unit]]
        xx <- seq_len(nrow(d))
        graphics::plot(xx, d$observed, type = "n", xaxt = "n",
                       xlab = x$settings$time, ylab = x$settings$outcome,
                       main = paste("Observed and counterfactual:", unit), ...)
        graphics::polygon(c(xx, rev(xx)), c(d$lower, rev(d$upper)),
                          col = "#9ECAE180", border = NA)
        graphics::lines(xx, d$counterfactual, col = "#2171B5", lwd = 2, lty = 2)
        graphics::lines(xx, d$observed, col = "#222222", lwd = 2)
        graphics::axis(1, at = xx, labels = as.character(d$time))
        k <- which(d$post_shock)[1L]
        graphics::abline(v = k, col = "#CB181D", lty = 3, lwd = 2)
        graphics::legend("topleft",
                         c("Observed", "Counterfactual", "Prediction interval", "Shock"),
                         col = c("#222222", "#2171B5", "#9ECAE1", "#CB181D"),
                         lty = c(1, 2, 1, 3), lwd = c(2, 2, 6, 2), bty = "n")
    } else if (type == "index") {
        o <- order(x$results$ERRI)
        bp <- graphics::barplot(x$results$ERRI[o], names.arg = x$results$unit[o],
                                horiz = TRUE, las = 1, xlim = c(0, 100),
                                col = "#2C7FB8", xlab = "ERRI (0-100)", ...)
        graphics::text(x$results$ERRI[o], bp,
                       labels = round(x$results$ERRI[o], 1), pos = 4, xpd = TRUE)
    } else {
        cols <- grep("_score$", names(x$results), value = TRUE)
        z <- as.matrix(x$results[cols])
        graphics::matplot(t(z), type = "b", pch = seq_len(nrow(z)),
                          lty = 1, xaxt = "n", ylim = c(0, 100),
                          xlab = "Component", ylab = "Score", ...)
        graphics::axis(1, seq_len(ncol(z)),
                       sub("_score$", "", cols), las = 2)
        graphics::legend("topright", x$results$unit,
                         col = seq_len(nrow(z)), pch = seq_len(nrow(z)),
                         lty = 1, bty = "n")
    }
    invisible(x)
}