R/ahp_pwerror.R

In ahpsurvey: Analytic Hierarchy Process for Survey Data

#' Finds the pairwise comparisons with the maximum amount of inconsistency
#'
#' @author Frankie Cho
#'
#' @description After constructing a list of matrices with \eqn{\epsilon_{ij} = a_{ij}w_{j}/w_{i}} (following `ahp.error`), this algorithm extracts the top `n` numbers of pairwise comparison matrices with the highest \eqn{\epsilon_{ij}} for each decision-maker.
#'
#' @param ahpmat A list of pairwise comparison matrices of each decision maker generated by `ahp.mat`.
#' @param atts a list of attributes in the correct order
#' @param npw Number of pairwise comparisons
#'
#' @return A list of matrices containing \eqn{\epsilon_{ij} = a_{ij}w_{j}/w_{i}} for each decision-maker, with elements from the lower triangle set as NA automatically (since it is essentially equal to the element in the upper triangle).
#'
#'@include ahp_mat.R
#'
#' @examples
#'
#' library(magrittr)
#'
#' atts <- c('cult', 'fam', 'house', 'jobs', 'trans')
#'
#'data(city200)
#'
#' cityahp <- ahp.mat(city200, atts, negconvert = TRUE)
#' ahp.error(cityahp, atts)
#'
#'
#'@references
#'
#'\insertRef{Saaty2004}{ahpsurvey}
#'
#'@include ahp_indpref.R
#'
#'@export
#'
ahp.pwerror <- function(ahpmat, atts, npw = 3) {
    indpref.df <- ahp.indpref(ahpmat, atts, method = "eigen")
    respmat <- ahpmat
    conserror <- list()
    topincons <- list()
    
    for (ind in 1:length(ahpmat)) {
        indpref <- t(indpref.df[1, ])
        rownames(indpref) <- NULL
        indpref <- as.vector(indpref)
        
        ## Matrix where perfect consistency holds
        pjpi <- indpref %*% (t(indpref))^-1
        
        ## Create a matrix of the consistency errors (.conserror) Use an if statement to see
        ## whether to take the reciprocal of numbers smaller than 1
        .conserror <- respmat[[ind]] * t(pjpi)
        
        ## Setting the column names of the inconsistency matrix
        colnames(.conserror) <- colnames(pjpi) <- atts
        rownames(.conserror) <- rownames(pjpi) <- atts
        
        ## Add minor jitters for easier sorting
        .conserror <- jitter(.conserror, amount = 0.001)
        
        ## Define functions for the second and third largest element in the consistency error
        ## matrix
        topn <- function(x, i) sort(x, partial = length(x) - i + 1)[length(x) - i + 1]
        
        .maxdf <- matrix(nrow = npw, ncol = 2)
        
        toppw <- c(rep(NA, npw))
        
        ## Saving the indices of the pairwise comparisons where the inconsistency is found
        for (i in 1:npw) {
            ## Print warning if the error is equal to 1
            if (topn(.conserror, i) <= 1.001) {
                print(paste("Warning: eij=1 for Ind", ind, " of the top", npw, " comparison", 
                  sep = ""))
            }
            
            ## Make a dataframe which contains the matrix indices of the largest n error terms
            .maxdf[i, ] <- sort(which(.conserror == topn(.conserror, i), arr.ind = TRUE)[1:2])
            
            ## Convert those to attribute names and save them to a list
            toppw[i] <- paste(atts[.maxdf[i, 1]], "_", atts[.maxdf[i, 2]], sep = "")
        }
        
        ## Saving top inconsistency pairwise comparisons to a dataframe
        topincons[[ind]] <- toppw
    }
    topdf <- as.data.frame(t(as.data.frame(topincons)))
    rownames(topdf) <- NULL
    topnum <- function(n) {
        numlist <- c(rep(NA, n))
        for (i in 1:n) {
            numlist[i] <- paste("top", i, sep = "")
        }
        numlist
    }
    
    colnames(topdf) <- topnum(npw)
    topdf
}