R/ahp_missing.R

In frankiecho/ahpsurvey: Analytic Hierarchy Process for Survey Data

#' Impute missing observations using the maximum deviation method.
#'
#' @author Frankie Cho
#'
#' @description Imputes the missing values of a list of matrices produced by `ahp.mat` using the maximum deviation method. Missing values must be coded as `NA`. A minimum of n-1 comparisons must be made, where n is the number of attributes (assuming that the decision-maker is perfectly consistent). Note that the algorithm assumes that the NA values will be imputed under perfect consistency with the other pairwise comparisons made.
#'
#' @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`.
#'
#' @return A list of matrices with all `NA` values imputed.
#'
#'@include ahp_mat.R
#'
#' @examples
#'
#' library(magrittr)
#'
#' atts <- c('cult', 'fam', 'house', 'jobs', 'trans')
#'
#' data(city200)
#'
#' set.seed(42)
#' ## Make a dataframe that is missing at random
#' missing.df <- city200[1:10,]
#' for (i in 1:10){
#'   missing.df[i, round(stats::runif(1,1,10))] <- NA
#' }
#' missingahp <- ahp.mat(missing.df, atts, negconvert = TRUE)
#' ahp.missing(missingahp, atts)
#'
#'@references
#'
#'\insertAllCited{}
#'
#'@include ahp_indpref.R
#'
#'
#'@export


ahp.missing <- function(ahpmat, atts, round = FALSE, limit = FALSE) {
    respmat <- ahpmat
    ## Create a new matrix and replace it with new elements
    .replace <- ahpmat
    cr <- list()
    
    for (ind in 1:length(ahpmat)) {
        
        .missingi <- c()
        .missingj <- c()
        
        .NArows <- which(is.na(respmat[[ind]]) == TRUE, arr.ind = TRUE) %>% data.frame() %>% 
            dplyr::filter(row > col)
        
        ## Moves onto the next matrix if there is no 
        if(nrow(.NArows) == 0) next
        
        ## Give an error if there is one or more variable with no occurences and move onto the
        ## next decision-maker
        .rowfreq <- .NArows %>% count(row)
        
        .rowfreq <- max(.rowfreq$n)
        
        .colfreq <- .NArows %>% count(col)
        
        .colfreq <- max(.colfreq$n)
        
        if (.rowfreq >= length(atts) - 1 | .colfreq >= length(atts) - 1) {
            warning(paste("Warning: Ind", ind, "has one or more attribute(s) with no comparisons. The NA values are not replaced for this decision-maker."))
            next
        }
        
        nmiss <- nrow(.NArows)
        
        ## Create a new matrix B and replace wi/wj as 0 and diagonals as 2
        .B <- .replace[[ind]]
        
        for (i in 1:length(atts)) {
            .B[i, i] <- apply(is.na(.B) == TRUE, 1, sum)[i] + 1
        }
        
        for (id in 1:nmiss) {
            
            ## Find out the index are missing
            
            ### In the matrix of indices of missing values, find the ith element in the 1st row
            .missingi[id] <- .NArows[id, 1]
            
            ### In the matrix of indices of missing values, find the ith element in the 2nd row
            .missingj[id] <- .NArows[id, 2]
            ## Replace those as 0
            .B[.missingi[id], .missingj[id]] <- .B[.missingj[id], .missingi[id]] <- 0
            
            ## Replace those diagonal elements to 0 too
            .B[length(atts) - .missingi[id], length(atts) - .missingj[id]] <- .B[length(atts) - 
                .missingj[id], length(atts) - .missingi[id]] <- 0
        }
        ## Replace the diagonals of the replacement matrix with number of missing elements in
        ## that row + 1
        
        .Blist <- list(.B)
        ## Calculate weights of .Blist
        .Bweights <- ahp.indpref(.Blist, atts, method = "eigen")
        
        for (id in 1:nmiss) {
            
            .pipj <- as.numeric(.Bweights[.missingi[id]]/.Bweights[.missingj[id]])
            
            ## 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]][.missingi[id], .missingj[id]] <- as.numeric(.pipj)
            .replace[[ind]][.missingj[id], .missingi[id]] <- as.numeric(1/.pipj)
        }
        colnames(.replace[[ind]]) <- rownames(.replace[[ind]]) <- atts
    }
    .replace
}