R/ahp_md.R

Defines functions ahp.md

Documented in ahp.md

#' Replace inconsistent pairwise comparisons with the maximum deviation method
#'
#' @author Frankie Cho
#'
#' @description Based on the matrix derived from `ahp.error`, replaces the top `n` number of inconsistent pairwise comparisons with a value calculated by from the maximum deviation method. For a full explication of the method see \insertCite{Saaty2003;textual}{ahpsurvey}. Replaces the old `ahp.harker` function before 0.4.2 but contains exactly the same functionality.
#' 
#' @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 round Rounds the imputation values of the matrix to the nearest integer if `TRUE`. Defaults to `FALSE`.
#' @param limit If set to `TRUE`, if the imputation value is larger than 9 or smaller than 1/9, the value is converted to 9 and 1/9 respectively. Defaults to `FALSE`.
#' @param iterations The number of comparisons with the highest inconsistency to be changed. For example, if `iterations = 3`, `ahp.md` changes the first, second, and third most inconsistent pairwise comparisons using that method. Defaults to `1`.
#' @param stopcr The stopping Consistency Ratio, which was calculated by `ahp.cr`. Complements `iter` by giving `iterations` a attribute to stop when a matrix is sufficiently consistent. The function will continue looping and replacing more elements of the pairwise comparison matrices until the consistency ratio of the new matrix is lower than `stopcr`, or the maximum number of iterations is reached, and will stop and move onto the next individual. When `stopcr` is set, the number of replaced elements will differ among each decision-maker. Defaults to `0` (i.e. the loop will not be stopped unless `iterations` is reached)
#' @param printiter Whether the number of iterations taken for each pairwise matrix is reported or not. If `printiter = TRUE`, it prints out the final number of iterations that each individual decision-maker took to reach a value lower than `stopcr`. Generally it is not needed if `stopcr` is not specified. When `stopcr` is specified, this is a good way of identifying how many pairwise comparisons are actually replaced by the algorithm for each decision maker. Defaults to `TRUE`.
#'
#' @return A list of matrices with values replaced with consistent values.
#'
#'@include ahp_mat.R
#'
#' @seealso ahp.error ahp.cr
#' @examples
#'
#' atts <- c('cult', 'fam', 'house', 'jobs', 'trans')
#'
#' data(city200)
#'
#' cityahp <- ahp.mat(city200, atts, negconvert = TRUE)
#' ahp.md(cityahp, atts)
#'
#'@references
#'
#'\insertAllCited{}
#'
#'@include ahp_indpref.R ahp_bweight.R ahp_cr.R
#'
#'@export
#'
ahp.md <- function(ahpmat, atts, round = FALSE, limit = FALSE, iterations = 1, stopcr = 0, 
                       printiter = TRUE) {
  
  .replace2 <- .replace <- ahpmat
  
  tri <- function(n) {
    x <- (n - 1) * (n)/2
    x
  }
  
  if (iterations > tri(length(atts))) {
    stop("Iterations cannot be larger than the number of elements in the upper triangular matrix!")
  }
  
  for (ind in 1:length(ahpmat)) {
    
    currentmat <- ahpmat[[ind]]
    
    .conserror <- ahp.error(list(currentmat), atts)[[1]]
    
    ## Setting the column names of the inconsistency matrix
    .conserror[lower.tri(.conserror)] <- 1
    
    topn <- function(x, i) sort(x, partial = length(x) - i + 1)[length(x) - i + 1]
    
    currentcr <- ahp.cr(list(currentmat), atts)
    
    if (currentcr < stopcr) {
      if (printiter == T) 
        print(paste("Ind", ind, "No iterations needed"))
      next
    }
    
    .maxlength <- tri(length(atts))
    
    ## Adding minor noises to consistency error matrix for easier sorting in case some
    ## errors are the same
    .conserror <- jitter(.conserror, amount = 0.001)
    
    ## Create a dataframe with the locations of the most inconsistent pairwise comparisons
    .maxdf <- matrix(nrow = .maxlength, ncol = 2)
    colnames(.maxdf) <- c("row", "col")
    
    for (i in 1:.maxlength) {
      .maxdf[i, ] <- which(.conserror == topn(.conserror, i), arr.ind = TRUE)[1:2]
    }
    
    for (nelement in 1:iterations) {
      
      .Bweights <- ahp.bweight(currentmat, atts, maxdf = .maxdf, nelement = nelement)
      
      for (row in 1:iterations) {
        i <- as.numeric(.maxdf[nelement, 1])
        j <- as.numeric(.maxdf[nelement, 2])
        
        .pipj <- as.numeric(.Bweights[i]/.Bweights[j])
        
        ## Numeric rounding to the nearest integer and its reciprocal
        if (round == TRUE) {
          if (.pipj >= 1) {
            .pipj <- round(.pipj)
          } else if (.pipj < 1 & .pipj > 0) 
            .pipj <- 1/round(1/.pipj)
        }
        
        ## Round numbers back to 9 if limit == TRUE
        if (limit == TRUE) {
          if (.pipj > 9) {
            .pipj <- 9
          } else if (.pipj < 1/9) {
            .pipj <- 1/9
          }
        }
        
        .replace[[ind]][i, j] <- as.numeric(.pipj)
        .replace[[ind]][j, i] <- as.numeric(1/.pipj)
      }
      
      cr <- list(.replace[[ind]]) %>% ahp.cr(atts)
      
      if (cr < stopcr) {
        .replace2[[ind]] <- .replace[[ind]]
        if (printiter == T) {
          print(paste("Ind", ind, "Iterations:", nelement))
        }
        break
      } else if (nelement == iterations) {
        .replace2[[ind]] <- .replace[[ind]]
        if (printiter == T) 
          print(paste("Ind", ind, "last iteration"))
      }
    }
  }
  return(.replace2)
}
frankiecho/ahpsurvey documentation built on Aug. 22, 2021, 5:28 p.m.