R/create_performance_table.R

Defines functions create_performance_table

#' @export
create_performance_table <- function(criteria,
                                     decisions_and_alternatives) {
  criteria_ids <-
    criteria$criteriaDf[criteria$criteriaDf$leafCriterion, 'id'];
  criteria_labels <-
    criteria$criteriaDf[criteria$criteriaDf$leafCriterion, 'label'];
  decision_ids <- decisions_and_alternatives$alternativesDf$decision_id;
  decision_labels <- decisions_and_alternatives$alternativesDf$decision_label;
  alternative_values <- decisions_and_alternatives$alternativesDf$value;
  alternative_labels <- decisions_and_alternatives$alternativesDf$label;

  if (length(criteria_ids) != length(criteria_labels)) {
    stop("Wow, this is weird. This definitely shouldn't happen.");
  }

  nCols <- 4 + length(criteria_ids);

  resTop <-
    matrix(c(NA_character_, NA_character_, NA_character_, NA_character_, criteria_ids,
             NA_character_, NA_character_, NA_character_, NA_character_, criteria_labels),
           byrow=TRUE,
           ncol=nCols);

  resBottom <-
    matrix(c(decision_ids,
             alternative_values,
             decision_labels,
             alternative_labels,
             rep(NA_character_, length(criteria_ids) * length(decision_ids))),
           ncol=nCols);

  res <- rbind(resTop,
               resBottom);

  class(res) <- c('dmcda', 'performance_table', class(res));

  return(res);
}
Matherion/mdmcda documentation built on Dec. 31, 2020, 3:13 p.m.