Search code examples
rmcdm

VIKOR function from MCDM R package is returning error


I am trying to run VIKOR from MCDM R package using the following code

library(MCDM)

 d <- matrix(c(1,2,5,3000,3750,4500),nrow = 3,ncol = 2)
 w <- c(0.5,0.5)
 cb <- c('min','max')
 v <- 0.5
 VIKOR(d,w,cb,v)

But it returns me following error

Error in (Q == "NaN") || (Q == "Inf") : 'length = 3' in coercion to 'logical(1)'

How can I solve this error?

The source code for VIKOR is available here.


Solution

  • I have solved this problem by modifying the source code like

    VIKOR <- function(decision, #matrix with all the alternatives
                      weights,  #vector with the numeric values of the weights
                      cb,       #vector with the "type" of the criteria (benefit = "max", cost = "min")
                      v         #value with the real number of the 'v' parameter to calculate Q
    )
    {
      #Checking parameters
      if(! is.matrix(decision))
        stop("'decision' must be a matrix with the values of the alternatives")
      if(missing(weights))
        stop("a vector containing n weigths, adding up to 1, should be provided")
      if(sum(weights) != 1)
        stop("The sum of 'weights' is not equal to 1")
      if(! is.character(cb))
        stop("'cb' must be a character vector with the type of the criteria")
      if(! all(cb == "max" | cb == "min"))
        stop("'cb' should contain only 'max' or 'min'")
      if(length(weights) != ncol(decision))
        stop("length of 'weights' does not match the number of the criteria")
      if(length(cb) != ncol(decision))
        stop("length of 'cb' does not match the number of the criteria")
      if(missing(v))
        stop("a value for 'v' in [0,1] should be provided")
      
      #1. Ideal solutions
      posI <- as.integer(cb == "max") * apply(decision, 2, max) +
        as.integer(cb == "min") * apply(decision, 2, min)
      negI <- as.integer(cb == "min") * apply(decision, 2, max) +
        as.integer(cb == "max") * apply(decision, 2, min)
      
      #2. S and R index
      norm =function(x,w,p,n){
        w*((p-x)/(p-n))
      }
      SAux <- apply(decision, 1, norm, weights, posI, negI)
      S <- apply(SAux, 2, sum)
      R <- apply(SAux, 2, max)
      
      
      #3. Q index
      #If v=0
      if (v==0)
        Q <- (R-min(R))/(max(R)-min(R))
      #If v=1
      else if (v==1)
        Q <- (S-min(S))/(max(S)-min(S))
      #Another case
      else
        Q <- v*(S-min(S))/(max(S)-min(S))+(1-v)*(R-min(R))/(max(R)-min(R))
      
      #4. Checking if Q is valid
      #Here is the change by taking help from https://stackoverflow.com/questions/76667355/how-to-ignore-ranking-if-the-data-conatins-nan-or-inf-in-r
      RankingQ = ifelse(is.infinite(Q) | is.na(Q), NA,
             rank(Q, ties.method = "first"))
      
      #5. Ranking the alternatives
      return(data.frame(Alternatives = 1:nrow(decision), S = S, R = R, Q = Q, 
                        Ranking = RankingQ))
      
    }
    

    Now it is working fine like

    d <- matrix(c(1,2,5,3000,3750,4500),nrow = 3,ncol = 2)
    w <- c(0.5,0.5)
    cb <- c('min','max')
    v <- 0.5
    VIKOR(d,w,cb,v)
    
    #>  Alternatives     S    R Q Ranking
    #> 1            1 0.500 0.50 1       2
    #> 2            2 0.375 0.25 0       1
    #> 3            3 0.500 0.50 1       3