diff --git a/DESCRIPTION b/DESCRIPTION index fb34027..4babf5f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: MCDM Type: Package Title: Multi-Criteria Decision Making Methods for Crisp Data -Version: 1.1 -Date: 2016-09-05 +Version: 1.2 +Date: 2016-09-21 Author: Blanca A. Ceballos Martin Maintainer: Blanca A. Ceballos Martin Description: Implementation of several MCDM methos for crisp data for decision @@ -16,6 +16,6 @@ URL: http://decsai.ugr.es/index.php?p=miembros&id=19909 LazyData: true RoxygenNote: 5.0.1 NeedsCompilation: no -Packaged: 2016-09-05 11:31:04 UTC; Modo +Packaged: 2016-09-22 08:31:35 UTC; Modo Repository: CRAN -Date/Publication: 2016-09-05 13:53:38 +Date/Publication: 2016-09-22 16:50:45 diff --git a/MD5 b/MD5 index b2a59ed..76ef512 100644 --- a/MD5 +++ b/MD5 @@ -1,12 +1,12 @@ -69910b71bb5bd011e994234c8b59b0c1 *DESCRIPTION +85c40131e9bb8ed23b4d12207b54a85c *DESCRIPTION 9b7c4e38c891101fd4549788a687c7de *NAMESPACE 8287ca47154ab5e73e30274a16880212 *R/MMOORA.R -5b035e73afcd7f7bae9d167620a5a93b *R/MetaRanking.R -76fbfe56c0a7f78ed63313786b5cff85 *R/RIM.R -00ac3bdfc38bc0f08b8c3c52233e6555 *R/TOPSISLinear.R +266d922c53def0d332ea7c58905294d6 *R/MetaRanking.R +c4ef60a9760928352d2d83df4ebf2d73 *R/RIM.R +14db364d3779af1b8b7e9b3267106ad3 *R/TOPSISLinear.R 4688cfc2894c6138351b9d12525d697d *R/TOPSISVector.R -8d25956de81910c4f10a7d01606915a3 *R/TheoryOfDominance.R -36138b0987e910975df5fd5e956556a2 *R/VIKOR.R +6a66f6cdc3e5fd524cd010c82307e5ab *R/TheoryOfDominance.R +01529281754fede909161af523879a8a *R/VIKOR.R b5f8ffd3b9c728bd73b802be03486e88 *R/WASPAS.R 6803bdbf53ad9f3fd94ebe327a580fb6 *man/MMOORA.Rd 7e39cee422906ca0e238c31f6aaa3d15 *man/MetaRanking.Rd diff --git a/R/MetaRanking.R b/R/MetaRanking.R index acbcc44..0b45c3d 100644 --- a/R/MetaRanking.R +++ b/R/MetaRanking.R @@ -47,16 +47,25 @@ MetaRanking <- function(decision, #matrix with all the alternatives Waspas = WASPAS(decision,weights,cb,lambda) #Meta-Ranking - MetaR = MMoora[,8]+Rim[,3]+TopsisV[,3]+TopsisL[,3]+Vikor[,5]+Waspas[,5] + if(Vikor[1,5] == "-"){ + MetaR = MMoora[,8]+Rim[,3]+TopsisV[,3]+TopsisL[,3]+Waspas[,5] + }else{ + MetaR = MMoora[,8]+Rim[,3]+TopsisV[,3]+TopsisL[,3]+Vikor[,5]+Waspas[,5] + } + #Ranking Aggregated - #library(RankAggreg) - ra = rbind(MMoora[,8],Rim[,3],TopsisV[,3],TopsisL[,3],Vikor[,5],Waspas[,5]) - if(nrow(decision)<=10) + if(Vikor[1,5] == "-"){ + ra = rbind(MMoora[,8],Rim[,3],TopsisV[,3],TopsisL[,3],Waspas[,5]) + }else{ + ra = rbind(MMoora[,8],Rim[,3],TopsisV[,3],TopsisL[,3],Vikor[,5],Waspas[,5]) + } + + if(nrow(decision)<=10){ RA = RankAggreg::BruteAggreg(ra, nrow(decision), distance="Spearman") - else + }else{ RA = RankAggreg::RankAggreg(ra, nrow(decision), method = "GA", distance = "Spearman", verbose=FALSE) - + } return(data.frame(Alternatives = 1:nrow(decision), MMOORA = MMoora[,8], RIM = Rim[,3], TOPSISVector = TopsisV[,3], TOPSISLinear = TopsisL[,3], VIKOR = Vikor[,5], WASPAS = Waspas[,5], MetaRanking_Sum = rank(MetaR, ties.method= "first"), MetaRanking_Aggreg = RA$top.list)) diff --git a/R/RIM.R b/R/RIM.R index af2a99d..b0cf48b 100644 --- a/R/RIM.R +++ b/R/RIM.R @@ -50,7 +50,8 @@ RIM <- function(decision, #matrix with all the alternatives else if( ((decision[i,j]>= CD[2,j]) && (decision[i,j]<= AB[2,j])) && (CD[2,j]!=AB[2,j])){ N[i,j]=1-(min(abs(decision[i,j]-CD[1,j]),abs(decision[i,j]-CD[2,j]))/abs(CD[2,j]-AB[2,j])) } - else stop("error in normalization procedure: A != B and D != C") + else stop("Error in normalization procedure: if x is in [A,C], then A != C, + or if x is in [D,B], then D != B") } } diff --git a/R/TOPSISLinear.R b/R/TOPSISLinear.R index 9984fe3..927950b 100644 --- a/R/TOPSISLinear.R +++ b/R/TOPSISLinear.R @@ -1,74 +1,72 @@ -#' Implementation of TOPSIS Method for Multi-Criteria Decision Making Problems. -#' -#' @description The \code{TOPSISLinear} function implements the Technique for Order of Preference by Similarity to Ideal Solution (TOPSIS) Method with the linear transformation of maximum as normalization prodecure. -#' @param decision The decision matrix (\emph{m} x \emph{n}) with the values of the \emph{m} alternatives, for the \emph{n} criteria. -#' @param weights A vector of length \emph{n}, containing the weights for the criteria. The sum of the weights has to be 1. -#' @param cb A vector of length \emph{n}. Each component is either \code{cb(i)='max'} if the \emph{i-th} criterion is benefit or \code{cb(i)='min'} if the \emph{i-th} criterion is a cost. -#' @return \code{TOPSISLinear} returns a data frame which contains the score of the R index and the ranking of the alternatives. -#' @references Garcia Cascales, M.S.; Lamata, M.T. On rank reversal and TOPSIS method. Mathematical and Computer Modelling, 56(5-6), 123-132, 2012. -#' @examples -#' -#' d <- matrix(c(1,4,3,5,2,3),nrow = 3,ncol = 2) -#' w <- c(0.5,0.5) -#' cb <- c('max','max') -#' TOPSISLinear(d,w,cb) - -TOPSISLinear <- 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") -) -{ - #Checking the arguments - 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") - - #1. Normalization and weighting - N <- matrix(nrow = nrow(decision), ncol = ncol(decision)) - - Norm <- as.integer(cb == "max") * apply(decision, 2, max) + - as.integer(cb == "min") * apply(decision, 2, min) - - N <- matrix(nrow = nrow(decision), ncol = ncol(decision)) - for(j in 1:ncol(decision)){ - if (cb[j] == 'max'){ - N[,j] <- decision[,j] / Norm[j] - } - else{ - N[,j] <- Norm[j] / decision[,j] - } - } - W <- diag(weights) - NW <- N%*%W - - #2. Ideal solutions - posI <- as.integer(cb == "max") * apply(NW, 2, max) + - as.integer(cb == "min") * apply(NW, 2, min) - negI <- as.integer(cb == "min") * apply(NW, 2, max) + - as.integer(cb == "max") * apply(NW, 2, min) - - #3. Distances to the ideal solutions - distance =function(x,y){ - sqrt(sum((x - y) ^ 2)) - } - posDis <- apply(NW, 1, distance, posI) - negDis <- apply(NW, 1, distance, negI) - - #4. R index - R <- negDis/(negDis+posDis) - - #5. Rank the alternatives - return(data.frame(Alternatives = 1:nrow(decision), R = R, Ranking = rank(-R, ties.method= "first"))) - -} +#' Implementation of TOPSIS Method for Multi-Criteria Decision Making Problems. +#' +#' @description The \code{TOPSISLinear} function implements the Technique for Order of Preference by Similarity to Ideal Solution (TOPSIS) Method with the linear transformation of maximum as normalization prodecure. +#' @param decision The decision matrix (\emph{m} x \emph{n}) with the values of the \emph{m} alternatives, for the \emph{n} criteria. +#' @param weights A vector of length \emph{n}, containing the weights for the criteria. The sum of the weights has to be 1. +#' @param cb A vector of length \emph{n}. Each component is either \code{cb(i)='max'} if the \emph{i-th} criterion is benefit or \code{cb(i)='min'} if the \emph{i-th} criterion is a cost. +#' @return \code{TOPSISLinear} returns a data frame which contains the score of the R index and the ranking of the alternatives. +#' @references Garcia Cascales, M.S.; Lamata, M.T. On rank reversal and TOPSIS method. Mathematical and Computer Modelling, 56(5-6), 123-132, 2012. +#' @examples +#' +#' d <- matrix(c(1,4,3,5,2,3),nrow = 3,ncol = 2) +#' w <- c(0.5,0.5) +#' cb <- c('max','max') +#' TOPSISLinear(d,w,cb) + +TOPSISLinear <- 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") +) +{ + #Checking the arguments + 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") + + #1. Normalization and weighting + N <- matrix(nrow = nrow(decision), ncol = ncol(decision)) + + Norm <- as.integer(cb == "max") * apply(decision, 2, max) + + as.integer(cb == "min") * apply(decision, 2, min) + + N <- matrix(nrow = nrow(decision), ncol = ncol(decision)) + for(j in 1:ncol(decision)){ + if (cb[j] == 'max'){ + N[,j] <- decision[,j] / Norm[j] + } + else{ + N[,j] <- Norm[j] / decision[,j] + } + } + W <- diag(weights) + NW <- N%*%W + + #2. Ideal solutions + posI <- apply(NW, 2, max) + negI <- apply(NW, 2, min) + + #3. Distances to the ideal solutions + distance =function(x,y){ + sqrt(sum((x - y) ^ 2)) + } + posDis <- apply(NW, 1, distance, posI) + negDis <- apply(NW, 1, distance, negI) + + #4. R index + R <- negDis/(negDis+posDis) + + #5. Rank the alternatives + return(data.frame(Alternatives = 1:nrow(decision), R = R, Ranking = rank(-R, ties.method= "first"))) + +} diff --git a/R/TheoryOfDominance.R b/R/TheoryOfDominance.R index b246621..6cf60f4 100644 --- a/R/TheoryOfDominance.R +++ b/R/TheoryOfDominance.R @@ -1,22 +1,239 @@ -TheoryOfDominance <- function (Rrs,Rrp,Rm,decision) { - # Function that implements the theory of dominance for Multi-MOORA method. - # It requieres the ranking from the ration system, reference point, - # the full multiplicative form and the decision matrix. - Dominance <- cbind(Rrs,Rrp,Rm,seq(1, nrow(decision))) - - for(i in 1:nrow(decision)){ - for(j in i:nrow(decision)){ - resta = Dominance[i,] - Dominance[j,] - # It is calculated the dominance of the i over j - if ( (resta[2]<0 && resta[3]<0) || ( (resta[3]<0 && resta[4]<0) || (resta[2]<0 && resta[4]<0)) ) { - dom = 1 # i domains j - } else { # j domains i - aux=Dominance[j,] - # Change the values between i and j - Dominance[j,]=Dominance[i,] - Dominance[i,]=aux - } - } - } - return(Dominance[,4]) -} +TheoryOfDominance <- function (Rrs,Rrp,Rm,decision) { + #Theory of Dominance + Dominance <- cbind(Rrs,Rrp,Rm,rep(0, nrow(decision))) + MMRanking <- rep(0, nrow(decision)) + flag = 0 + for (i in 1:nrow(decision)){ + + PosRrs = which.min(Dominance[,1]) + PosRrp = which.min(Dominance[,2]) + PosRm = which.min(Dominance[,3]) + + #checking if it is "Overall Dominance" or "General Dominance in two of the three methods" + if ( (PosRrs == PosRrp) && (PosRrp == PosRm) ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrs == PosRrp ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrp == PosRm ){ + if ( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrs == PosRm ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else { # Not the case of "Overall Dominance" neither "General Dominance in two of the three methods" + # Cheking which dominates + Comparison <- rbind(Dominance[PosRrs,],Dominance[PosRrp,],Dominance[PosRm,]) + resta1 = Comparison[1,] - Comparison[2,] + resta2 = Comparison[2,] - Comparison[3,] + resta3 = Comparison[3,] - Comparison[1,] + #Dominance of Comparison[1,] and Comparison[2,] + dom = rep(0,3) + if ( (resta1[1]<0 && resta1[2]<0) || ( (resta1[2]<0 && resta1[3]<0) || (resta1[1]<0 && resta1[3]<0)) ) { + dom[1] = 1 + } else { + dom[1] = 2 + } + #Dominance of Comparison[2,] and Comparison[3,] + if ( (resta2[1]<0 && resta2[2]<0) || ( (resta2[2]<0 && resta2[3]<0) || (resta2[1]<0 && resta2[3]<0)) ) { + dom[2] = 2 + } else { + dom[2] = 3 + } + #Dominance of Comparison[3,] and Comparison[1,] + if ( (resta3[1]<0 && resta3[2]<0) || ( (resta3[2]<0 && resta3[3]<0) || (resta3[1]<0 && resta3[3]<0)) ) { + dom[3] = 3 + } else { + dom[3] = 1 + } + + if (dom[1] == dom[2]) { #Comparison[2,] dominates + if( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } + } else if (dom[2] == dom[3]) { #Comparison[3,] dominates + if( Dominance[PosRm,4] != -1 ){ + MMRanking[PosRm] = i + Dominance[PosRm,4] = -1 + Dominance[PosRm,1:3] = 999999999999 + } + } else if (dom[1] == dom[3]) { #Comparison[1,] dominates + if( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } + } else if ( (dom[1] != dom[2]) && (dom[2] != dom[3]) ){ + + cuales = rep(0,3) + if( (PosRrs < PosRrp) && (PosRrs < PosRm) ){ + cuales[1]=1 + Comparison2 <- rbind(Dominance[PosRrs,]) + } else if ( (PosRrp < PosRrs) && (PosRrp < PosRm) ){ + cuales[2]=1 + Comparison2 <- rbind(Dominance[PosRrp,]) + } else if ( (PosRm < PosRrs) && (PosRm < PosRrp) ){ + cuales[3]=1 + Comparison2 <- rbind(Dominance[PosRm,]) + } + Comparison2 <- rbind(Dominance[PosRrs,],Dominance[PosRrp,]) + resta4 = Comparison2[1,] - Comparison2[2,] + #Dominance of Comparison[1,] and Comparison[2,] + dom = rep(0,2) + if ( (resta4[1]<0 && resta4[2]<0) || ( (resta4[2]<0 && resta4[3]<0) || (resta4[1]<0 && resta4[3]<0)) ) { + dom[1] = 1 + } else { + dom[1] = 2 + } + if (dom[1] == 1) { #Comparison2[1,] dominates + + if (cuales[1]==1){ + if( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } + } else { + if( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } + } + + } else { #Comparison2[1,] dominates + + if (cuales[2]==1){ + if( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } + } else { + if( Dominance[PosRm,4] != -1 ){ + MMRanking[PosRm] = i + Dominance[PosRm,4] = -1 + Dominance[PosRm,1:3] = 999999999999 + } + } + } + } + + } + #Checking the final ranking + if (flag == 1){ + + PosRrs = which.min(Dominance[,1]) + PosRrp = which.min(Dominance[,2]) + PosRm = which.min(Dominance[,3]) + + + if ( (PosRrs == PosRrp) && (PosRrp == PosRm) ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrs == PosRrp ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrp == PosRm ){ + if ( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } else { + flag =1 + } + } else if( PosRrs == PosRm ){ + if ( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } else { + flag =1 + } + } else { + Comparison <- rbind(Dominance[PosRrs,],Dominance[PosRrp,],Dominance[PosRm,]) + resta1 = Comparison[1,] - Comparison[2,] + resta2 = Comparison[2,] - Comparison[3,] + resta3 = Comparison[3,] - Comparison[1,] + #Dominance of Comparison[1,] and Comparison[2,] + dom = rep(0,3) + if ( (resta1[1]<0 && resta1[2]<0) || ( (resta1[2]<0 && resta1[3]<0) || (resta1[1]<0 && resta1[3]<0)) ) { + dom[1] = 1 + } else { + dom[1] = 2 + } + #Dominance of Comparison[2,] and Comparison[3,] + if ( (resta2[1]<0 && resta2[2]<0) || ( (resta2[2]<0 && resta2[3]<0) || (resta2[1]<0 && resta2[3]<0)) ) { + dom[2] = 2 + } else { + dom[2] = 3 + } + #Dominance of Comparison[3,] and Comparison[1,] + if ( (resta3[1]<0 && resta3[2]<0) || ( (resta3[2]<0 && resta3[3]<0) || (resta3[1]<0 && resta3[3]<0)) ) { + dom[3] = 3 + } else { + dom[3] = 1 + } + + if (dom[1] == dom[2]) { #Comparison[2,] dominates + if( Dominance[PosRrp,4] != -1 ){ + MMRanking[PosRrp] = i + Dominance[PosRrp,4] = -1 + Dominance[PosRrp,1:3] = 999999999999 + } + } else if (dom[2] == dom[3]) { #Comparison[3,] dominates + if( Dominance[PosRm,4] != -1 ){ + MMRanking[PosRm] = i + Dominance[PosRm,4] = -1 + Dominance[PosRm,1:3] = 999999999999 + } + } else if (dom[1] == dom[3]) { #Comparison[1,] dominates + if( Dominance[PosRrs,4] != -1 ){ + MMRanking[PosRrs] = i + Dominance[PosRrs,4] = -1 + Dominance[PosRrs,1:3] = 999999999999 + } + } + + } + + } + + flag = 0 + } + + return(MMRanking) +} \ No newline at end of file diff --git a/R/VIKOR.R b/R/VIKOR.R index d970618..3ae41b6 100644 --- a/R/VIKOR.R +++ b/R/VIKOR.R @@ -1,71 +1,77 @@ -#' Implementation of VIKOR Method for Multi-Criteria Decision Making Problems. -#' -#' @description The \code{VIKOR} function implements the "VIseKriterijumska Optimizacija I Kompromisno Resenje" (VIKOR) Method. -#' @param decision The decision matrix (\emph{m} x \emph{n}) with the values of the \emph{m} alternatives, for the \emph{n} criteria. -#' @param weights A vector of length \emph{n}, containing the weights for the criteria. The sum of the weights has to be 1. -#' @param cb A vector of length \emph{n}. Each component is either \code{cb(i)='max'} if the \emph{i-th} criterion is benefit or \code{cb(i)='min'} if the \emph{i-th} criterion is a cost. -#' @param v A value in [0,1]. It is used in the calculation of the Q index. -#' @return \code{VIKOR} returns a data frame which contains the score of the S, R and Q indixes and the ranking of the alternatives according to Q index. -#' @references Opricovic, S.; Tzeng, G.H. Compromise solution by MCDM methods: A comparative analysis of VIKOR and TOPSIS. European Journal of Operational Research, 156(2), 445-455, 2004. -#' @examples -#' -#' 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) - -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. Ranking the alternatives - return(data.frame(Alternatives = 1:nrow(decision), S = S, R = R, Q = Q, Ranking = rank(Q, ties.method= "first"))) - -} +#' Implementation of VIKOR Method for Multi-Criteria Decision Making Problems. +#' +#' @description The \code{VIKOR} function implements the "VIseKriterijumska Optimizacija I Kompromisno Resenje" (VIKOR) Method. +#' @param decision The decision matrix (\emph{m} x \emph{n}) with the values of the \emph{m} alternatives, for the \emph{n} criteria. +#' @param weights A vector of length \emph{n}, containing the weights for the criteria. The sum of the weights has to be 1. +#' @param cb A vector of length \emph{n}. Each component is either \code{cb(i)='max'} if the \emph{i-th} criterion is benefit or \code{cb(i)='min'} if the \emph{i-th} criterion is a cost. +#' @param v A value in [0,1]. It is used in the calculation of the Q index. +#' @return \code{VIKOR} returns a data frame which contains the score of the S, R and Q indixes and the ranking of the alternatives according to Q index. +#' @references Opricovic, S.; Tzeng, G.H. Compromise solution by MCDM methods: A comparative analysis of VIKOR and TOPSIS. European Journal of Operational Research, 156(2), 445-455, 2004. +#' @examples +#' +#' 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) + +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 + if( (Q == "NaN") || (Q == "Inf")){ + RankingQ <- rep("-",nrow(decision)) + }else{ + RankingQ <- rank(Q, ties.method= "first") + } + #5. Ranking the alternatives + return(data.frame(Alternatives = 1:nrow(decision), S = S, R = R, Q = Q, Ranking = RankingQ)) + +}