R/ahp_indpref.R

Defines functions ahp.indpref

Documented in ahp.indpref

#' Computes priority weights of individual decision-makers
#'
#' @author Frankie Cho
#'
#' @description `ahp.indpref` computes the individual priorities of the decision-makers, and returns a `data.frame` containing the priority weights of the decision-makers.
#'
#' @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 method if `method = "eigen"`, the individual priority weights are computed using the Dominant Eigenvalues method described in \insertCite{Saaty2003;textual}{ahpsurvey}. Otherwise, then the priorities are computed based on the averages of normalized values. Basically it normalizes the matrices so that all of the columns add up to 1, and then computes the averages of the row as the priority weights of each attribute. Three other modes of finding the averages are available:  ``arithmetic``: the arithmetic mean; ``geometric``: the geometric mean (the default); ``rootmean``: the square root of the sum of the squared value.
#'
#' @return A `data.frame` of the individual priorities of all the decision-makers.
#'
#'@include ahp_mat.R
#'
#' @examples
#'
#'data(city200)
#'atts <- c('cult', 'fam', 'house', 'jobs', 'trans')
#'
#' cityahp <- ahp.mat(df = city200, atts = atts, negconvert = TRUE) 
#' ahp.indpref(cityahp, atts, method = "eigen")
#'
#'@references
#'
#'\insertAllCited{}
#'
#'@export

ahp.indpref <- function(ahpmat, atts, method = "geometric") {
  
  respmat <- ahpmat
    
    stdmat <- list()
    for (ind in 1:length(respmat)) {
        stdmat[[ind]] <- scale(respmat[[ind]], center = FALSE, scale = colSums(respmat[[ind]]))
    }
    
    for (ind in 1:length(respmat)) attr(stdmat[[ind]], "scaled:scale") <- NULL
    
    gm_mean <- function(x, na.rm = TRUE) {
        exp(sum(log(x[x > 0]), na.rm = na.rm)/length(x))
    }
    
    root_mean <- function(x) sqrt(mean(x^2))
    
    if (method == "arithmetic") {
        meanmethod <- mean
    } else if (method == "geometric") {
        meanmethod <- gm_mean
    } else if (method == "rootmean") {
        meanmethod <- root_mean
    } else if (method == "eigen") {
    } else {
        print("Method invalid!")
    }
    
    if (method == "eigen") {
        indpref.df <- matrix(nrow = length(atts), ncol = length(respmat), data = NA)
        for (ind in 1:length(respmat)) {
            
            .iter <- list()
            .scale <- list()
            .norm <- list()
            
            .iter[[1]] <- rowSums(respmat[[ind]])/length(atts)
            .scale[[1]] <- .iter[[1]]/max(.iter[[1]])
            
            for (i in 1:11) {
                .iter[[i + 1]] <- respmat[[ind]] %*% .iter[[i]]
                .scale[[i + 1]] <- .iter[[i + 1]]/max(.iter[[i + 1]])
                .norm[[i + 1]] <- .scale[[i + 1]]/sum(.scale[[i + 1]])
            }
            indpref.df[, ind] <- .norm[[12]]
        }
        indpref.df <- as.data.frame(t(indpref.df))
        colnames(indpref.df) <- atts
    } else {
        indpref <- list()
        for (ind in 1:length(respmat)) indpref[[ind]] <- apply(stdmat[[ind]], 1, meanmethod)/sum(apply(stdmat[[ind]], 
            1, meanmethod))
        indpref.df <- data.frame(matrix(unlist(indpref), nrow = length(respmat), byrow = T), 
            stringsAsFactors = FALSE)
        colnames(indpref.df) <- atts
    }
    indpref.df
}

Try the ahpsurvey package in your browser

Any scripts or data that you put into this service are public.

ahpsurvey documentation built on March 26, 2020, 8 p.m.