R/scoreBarchart_scenarios_decisions.R

In Matherion/mdmcda: Multi Decision Multi Criteria Decision Analysis

#' @export
scoreBarchart_scenarios_decisions <- function (weighedEstimates,
                                               estimateCol,
                                               decisionOrder = NULL,
                                               decisionLabels = NULL,
                                               scenarioOrder = NULL,
                                               scenarioLabels = NULL,
                                               strokeSize = 0,
                                               strokeColor = "black",
                                               wrapScenarioLabels = 10,
                                               wrapDecisionLabels = 50,
                                               title = "MDMCDA scores by scenario by decision",
                                               xLab = "Scenario",
                                               yLab = "Weighed estimated effect",
                                               theme = ggplot2::theme_minimal(base_size = mdmcda::opts$get("ggBaseSize")),
                                               guides = ggplot2::guide_legend(ncol = 2),
                                               axis.text.x.bottom = ggplot2::element_text(angle = 0,
                                                                                          hjust = .5,
                                                                                          vjust = 1),
                                               legend.position = "bottom",
                                               legend.box.margin = ggplot2::margin(.5, .5, .5, .5, "cm")) {

  criterionLabel_col <- mdmcda::opts$get("criterionLabel_col");
  criterionId_col <- mdmcda::opts$get("criterionId_col");
  decisionId_col <- mdmcda::opts$get("decisionId_col");
  decisionLabel_col <- mdmcda::opts$get("decisionLabel_col");
  scenarioId_col <- mdmcda::opts$get("scenarioId_col");
  scenarioLabel_col <- mdmcda::opts$get("scenarioLabel_col");

  if (is.null(criterionOrder)) {
    criterionOrder <- unique(weighedEstimates[, criterionId_col]);
  }
  if (is.null(criterionLabels)) {
    criterionLabels <- stats::setNames(criterionOrder,
                                       nm = criterionOrder);
  }
  if (is.null(decisionOrder)) {
    decisionOrder <- unique(weighedEstimates[, decisionId_col]);
  }
  if (is.null(decisionLabels)) {
    decisionLabels <- stats::setNames(decisionOrder,
                                      nm = decisionOrder);
  }
  if (is.null(scenarioOrder)) {
    scenarioOrder <- unique(weighedEstimates[, scenarioId_col]);
  }
  if (is.null(scenarioLabels)) {
    scenarioLabels <- stats::setNames(scenarioOrder,
                                      nm = scenarioOrder);
  }

  decisionLabels <-
    unlist(lapply(decisionLabels, function(x)
      paste(strwrap(x, wrapDecisionLabels), collapse="\n")
    ));
  scenarioLabels <-
    unlist(lapply(scenarioLabels, function(x)
      paste(strwrap(x, wrapScenarioLabels), collapse="\n")
    ));

  tmpDf <- weighedEstimates[, c(scenarioId_col,
                                decisionId_col,
                                criterionId_col,
                                estimateCol)];

  tmpDf[, decisionLabel_col] <-
    factor(tmpDf[, decisionId_col],
           levels = decisionOrder,
           labels = decisionLabels[decisionOrder],
           ordered = TRUE);
  # tmpDf[, criterionLabel_col] <-
  #   factor(tmpDf[, criterionId_col],
  #          levels = criterionOrder,
  #          labels = criterionLabels[criterionOrder],
  #          ordered = TRUE);
  tmpDf[, scenarioLabel_col] <-
    factor(tmpDf[, scenarioId_col],
           levels = scenarioOrder,
           labels = scenarioLabels[scenarioOrder],
           ordered = TRUE);

  if (strokeSize == 0) {
    strokeType <- 0;
  } else {
    strokeType <- 1;
  }

  res <-
    ggplot2::ggplot(data = tmpDf,
                    mapping = ggplot2::aes_string(x=scenarioLabel_col,
                                                  y=estimateCol,
                                                  fill=decisionLabel_col)) +
    ggplot2::geom_col(color =strokeColor,
                      size = strokeSize,
                      linetype = strokeType) +
    ggplot2::scale_fill_viridis_d(name = "Decision") +
    ggplot2::scale_x_discrete(position="bottom") +
    theme +
    ggplot2::guides(fill = guides) +
    ggplot2::theme(axis.text.x.bottom = axis.text.x.bottom,
                   plot.title.position = "plot",
                   legend.position = legend.position,
                   legend.box.margin = legend.box.margin) +
    ggplot2::labs(title=title,
                  x=xLab,
                  y=yLab) +
    NULL;
  return(res);
}