# Welcome to the code to not only Test for Coherency but also get suggested corrections for incoherent priority vectors # All you need to do is # 1) define the number of alternatives (nalts) and # 2) define the total number of criteria (totalcrit) in the Supermatrix you are evaluating # 3) provide your weighted Supermatrix as a text file (see below) and # 4) run the code # Here is where you tell the program how many alternatives and criteria are in your model nalts=3 totalcrit=5 # Simply provide the Supermatrix as a text file. It should be in the form: (numbers only no labels) # Criteria Alternatives # Criteria # Alternatives # # Change to your file path where you pasted the Supermatrix in text document and according to your filename #for example ("C:/(fill in where your Supermatrix is)/myweightedsuper.txt") # This line reads the Supermatrix in weightedsuper=as.matrix(weightedsuper,nalts+totalcrit,nalts+totalcrit) # Next are settings that are currently set to default values but can be adjusted by the user # Here is where you can change the values for the lci steps used in the loops lcisteps=c(1.05, 1.15, 1.25) # You can change the limits for the minimum size required to be considered a good cluster # This is Step 1b clustaltcut=ceiling(nalts/2) clustcritcut=ceiling(totalcrit/2) # Choose the alternative and criterion that you will use to anchor (Not essential but this way you can choose) altanchor=3 critanchor=3 # What power to raise the Supermatrix to - must be even number (a balance of computation time and raising Supermatrix to the infinite power) powersuper=100 ################################################################################################## #now for the functions that will be called in the main method # This function provides a data quality check to see if the provided weighted Supermatrix is column stochastic and # does not have absorbing states. (i.e. ALL the columns sum to 1. Note: if there are entire columns that sum to 0 then # it is likely there are not enough connections to raise the Supermatrix to powers and not have the entire matrix # converge to 0 as the limit matrix is calculated) initialSupermatrixcheck<-function(weightedsuper,numelements){ connectioncheck=raisepowers(weightedsuper,100) addedtotal=0 for (i in 1:numelements){ for(j in 1:numelements){ addedtotal=addedtotal+connectioncheck[i,j] } } if((addedtotal-numelements<.0000001 && addedtotal-numelements>-.0000001)&&!(is.na(addedtotal))){ cat("Your weighted Supermatrix appears to be column stochastic.") cat("\n") cat("\n") return(1) } else{ cat("\n") cat("The weighted Supermatrix does NOT appear to be column stochastic OR may not have enough connectivity.", "\n","\n") cat("Before testing for Coherency the weighted Supermatrix which was provided was raised to powers and") cat("\n") cat("the 'limit matrix' is converging to 0.") cat("\n", "\n") cat("The sum of the elements of the 'limit matrix' is equal to: ",formatC(addedtotal,digits=6,format="f")," and it should be equal to: ",numelements, "based on") cat("\n") cat("the number of alternatives and criteria you provided as inputs.","\n") cat("\n") cat("While you can overide this data quality check in line 563 and rerun the code you should interpret those new results very carefully.") cat("\n","\n") cat("The SOLUTION may be as simple as correcting the number of alternatives and criteria that you define at the beginning of this code.") cat("\n","\n") cat("Another possible solution may be to address simple rounding issues in the data that you can fix by making sure") cat("\n") cat("each column sums exactly to 1 and then reload the weighted Supermatrix.") cat("\n","\n") cat("Another common problem we have seen is that the Supermatrix does not have") cat("\n") cat("enough connectivity to be raised to powers and not converge to 0.", "\n") cat("\n") cat("There are also issues with some of the decision making software programs implementing a 'fix' to avoid crashing","\n","the program but in the end providing misleading results.") cat("\n") cat("\n") cat("To address the last issue we recommend raising the Supermatrix to powers in Excel or other software","\n","to see what is happening to the Supermatrix as it is raised to powers.") cat("\n") cat("\n") cat("\n") return(0) } } # This function provides a data quality check to see if the provided weighted Supermatrix has enough connections between # the alternatives and criteria to be able to test for coherency. This is done by raising those parts of the weighted Supermatrix used # to test for coherency to powers and see that it does not converge to 0. LESupermatrixcheck<-function(weightedsuper,numelements){ connectioncheck=raisepowers(weightedsuper,100) addedtotal=0 nonnullcountalt=0 nonnullcountcrit=0 for (i in 1:numelements){ for(j in 1:numelements){ addedtotal=addedtotal+connectioncheck[i,j] } } for (i in 1:nalts){ for (j in 1:totalcrit){ if(weightedsuper[i+totalcrit,j]>=.001){ nonnullcountalt=nonnullcountalt+1 } } } for (i in 1:nalts){ for (j in 1:totalcrit){ if(weightedsuper[j,i+totalcrit]>=.001){ nonnullcountcrit=nonnullcountcrit+1 } } } if(nonnullcountalt!=nonnullcountcrit){ cat("There is a mismatch between the number of connections from the alternatives to the criteria and") cat("\n") cat("the connections from the criteria to the alternatives. This algorithm may or may not be able to") cat("\n") cat("fully address this issue. It will be important that you look at the 'allsupers' file to see how updates were made.") cat("\n") } if((addedtotal-numelements<.0000001 && addedtotal-numelements>-.0000001)&&!(is.na(addedtotal))){ cat("Your LE weighted Supermatrix appears to be column stochastic and have enough connections to proceed.") cat("\n") cat("\n") return(1) } else{ cat("\n") cat("The LE weighted Supermatrix does NOT appear to have enough connectivity.", "\n","\n") cat("Before testing for Coherency the LE weighted Supermatrix was raised to powers and its 'limit matrix' is converging to 0.") cat("\n", "\n") cat("The sum of the elements of this 'limit matrix' is equal to: ",formatC(addedtotal,digits=6,format="f")," and it should be equal to: ",numelements, "based on") cat("\n") cat("the number of alternatives and criteria you provided as inputs.","\n") cat("\n") cat("While you can overide this data quality check in line 563 and rerun the code you should interpret those new results very carefully.") cat("\n","\n") cat("The MAIN SOLUTION here is to return to the problem design and make sure there are ") cat("\n") cat("enough connections from the alternatives to the criteria and from the criteria to the alternatives.") cat("\n","\n") cat("Another solution may be as simple as correcting the number of alternatives and criteria that you define at the beginning of this code.") cat("\n","\n") cat("To address this issue we recommend raising the Supermatrix to powers in Excel or other software","\n","to see what is happening to the Supermatrix as it is raised to powers.") cat("\n") cat("\n") cat("\n") return(0) } } # This will raise the Supermatrix to powers to provide the limit matrix raisepowers<-function(matrix1,powers){ limit=matrix1 for (i in 1:powers){ limit=limit%*%matrix1 } return(limit) } # This function is called by the function "estimates" that will be used to normalizes the columns into ratios # of specific entries in each column. This is part of Step 1c normalizecolumn<-function(weightedsuper,colnum,anchr,totalcrit,nalts,altpriorities){ if (altpriorities==1){ size=nalts anchor=weightedsuper[totalcrit+anchr,colnum] place=totalcrit } else{ colnum=colnum+totalcrit size=totalcrit anchor=weightedsuper[anchr,colnum] place=0 } normalizedcol=matrix(0,size,1) for (i in 1:size){ normalizedcol[i,1]=weightedsuper[place+i,colnum]/anchor } return(normalizedcol) } # This function is called by "estimates" to convert the normalized entries into data that is in the same units as part of Step 1b which # will then be used to get the linking estimates in Step 1c altlinkingpin<-function(weighted,altanc,critanchor,step1,nalts,totalcrit,altpriorities){ if(altpriorities==1){ size=totalcrit linkinganchor=weighted[critanchor,totalcrit+altanc] } else{ size=nalts linkinganchor=weighted[totalcrit+altanc,critanchor] } constants=matrix(0,size,1) linkedstep2=step1 if(altpriorities==1){ for (i in 1:totalcrit){ constants[i,1]=weighted[i,altanc+totalcrit]/linkinganchor } for (i in 1:totalcrit){ for (j in 1:nalts){ linkedstep2[j,i]=linkedstep2[j,i]*constants[i,1] } } } else{ for (i in 1:nalts){ constants[i,1]=weighted[totalcrit+i,critanchor]/linkinganchor } for (i in 1:nalts){ for (j in 1:totalcrit){ linkedstep2[j,i]=linkedstep2[j,i]*constants[i,1] } } } return(linkedstep2) } # This function is called by estimates and is used to get the data for the bottom half of the entries in the linking estimates # It is part of Step 1c bottomhalffromlinked<-function(lvs,totalcrit,nalts){ matrixtopass=matrix(0,nalts+totalcrit,nalts+totalcrit) for (i in 1:totalcrit){ coltotal=0 for (k in 1:nalts){ coltotal=coltotal+lvs[k,i] } for (j in 1:nalts){ matrixtopass[totalcrit+j,i]=lvs[j,i]/coltotal } } return(matrixtopass) } # This is the main part of Step 1c that also calls the "normalize column, altlinkingpin, and bottom half from linked to calculate # the linking estimates and then the other half of the linking estimates. estimates<-function(c,weightedsuper,totalcrit,nalts,anchor,altpriorities){ #step1 inside if loops because of dimensions linker=c if(altpriorities==0){ step1=matrix(0,totalcrit,nalts) for (i in 1:nalts){ step1[,i]=normalizecolumn(weightedsuper,i,linker,totalcrit,nalts,altpriorities) } step2=altlinkingpin(weightedsuper,anchor,linker,step1,nalts,totalcrit,altpriorities) allsameunit=t(step2) } else { step1=matrix(0,nalts,totalcrit) for (i in 1:totalcrit){ step1[,i]=normalizecolumn(weightedsuper,i,linker,totalcrit,nalts,altpriorities) } step2=altlinkingpin(weightedsuper,linker,altanchor,step1,nalts,totalcrit,altpriorities) allsameunit=step2 } recoveredweightedsuper=bottomhalffromlinked(allsameunit,totalcrit,nalts) for (i in 1:nalts){ rowtotal=0 for (k in 1:totalcrit){ rowtotal=rowtotal+allsameunit[i,k] } for (j in 1:totalcrit){ recoveredweightedsuper[j,totalcrit+i]=allsameunit[i,j]/rowtotal } } return(recoveredweightedsuper) } #This is part of Step 1c that calculates the LCIs for each comparison of the linking estimates. lcimatrixpieces<-function(altpriorities,linkingsample,nalts,totalcrit){ # Define a cutoff value to deal with floats essentially if you are smaller than ... you are = to zero cu=.00001 if (altpriorities==0){ startrow=1+totalcrit startcolumn=1 size=totalcrit oppsize=nalts } else { startrow=1 startcolumn=1+totalcrit size=nalts oppsize=totalcrit } lcimatrix=diag(1,size,size) for (i in 1:(size-1)){ a=linkingsample[,,i] for (j in (i+1):size){ sumd=0 b=linkingsample[,,j] for (m in startrow:(startrow+oppsize-1)){ for (n in startcolumn:(startcolumn+size-1)){ if (b[m,n]>cu){ b[m,n]=1/b[m,n] } else { b[m,n]=0 } } } for (k in startrow:(startrow+oppsize-1)){ for (l in startcolumn:(startcolumn+size-1)){ d=a[k,l]*b[k,l] if (d<1 && d>cu){ d=1/d } sumd=sumd+d } } tentativelci=sumd/(nalts*totalcrit) lcimatrix[i,j]=tentativelci } } for (l in 1:size){ for (m in 2:size){ lcimatrix[m,l]=lcimatrix[l,m] } } return(lcimatrix) } #Now we calculate LCI Scores from the LCIs according to Step 1d. lciscores<-function(altpriorities,tcrit,nalt,lcivect,lowestingood){ if(altpriorities==0){ index=array(0,tcrit) gtop=lcivect for(i in 1:tcrit){ orderedgtop=sort(gtop[i,],decreasing=FALSE) index[i]=orderedgtop[lowestingood] index[i] } } else{ index=array(0,nalt) gside=lcivect for(i in 1:nalt){ orderedgside=sort(gside[i,],decreasing=FALSE) index[i]=orderedgside[lowestingood] } } return(index) } #This is part of Step 1e to find the MIPV findamax<-function(altpriorities,tcrit,nalt,lcivect){ if(altpriorities==0){ stopat1=0 mincnt=1 minvec=array(0,tcrit) while(stopat1<1){ if(lcivect[mincnt]==max(lcivect)) { minvec[mincnt]=1 stopat1=1 } mincnt=mincnt+1 } } else { stopat1=0 mincnt=1 minvec=array(0,nalt) while(stopat1<1){ if(lcivect[mincnt]==max(lcivect)) { minvec[mincnt]=1 stopat1=1 } mincnt=mincnt+1 } } return(minvec) } #These next 4 functions help to prepare a.k.a. reweight the weighted Supermatrix to deal with Supermatrices that #have entries in the inner and outer dependence of the Supermatrix and then again to reweight the Updated Supermatrix #before raising it to powers. #This function gets the weights for the priority vectors representing the comparisons among the criteria's influence within the alternatives getaltweights<-function(semi,wght,nlts,tcrit){ for(gw in 1:tcrit){ altweight=0 for(gw1 in (tcrit+1):(tcrit+nlts)){ altweight=altweight+semi[gw1,gw] } wght[1,gw]=altweight } return(wght) } #This function gets the weights for the priority vectors representing the comparisons among the alternative's influence within the criteria getcritweights<-function(semi,wght,nlts,tcrit){ for(gw in (tcrit+1):(tcrit+nlts)){ critweight=0 for(gw1 in 1:tcrit){ critweight=critweight+semi[gw1,gw] } wght[1,gw-tcrit]=critweight } return(wght) } # This function renormalizes the priority vectors representing the influence of the alternatives within the criteria in the Supermatrix # which is done before using the Supermatrix to get the linking estimates. reweightalt1<-function(semi,wght,nlts,tcrit){ for(gw in 1:tcrit){ for(gw1 in (tcrit+1):(tcrit+nlts)){ semi[gw1,gw]=semi[gw1,gw]*(1/wght[gw]) } } return(semi) } # This function renormalizes the priority vectors representing the influence of the criteria within the alternatives in the Supermatrix # which is done before using the Supermatrix to get the linking estimates. reweightcrit1<-function(semi,wght,nlts,tcrit){ for(gw in (tcrit+1):(tcrit+nlts)){ for(gw1 in 1:tcrit){ semi[gw1,gw]=semi[gw1,gw]*(1/wght[gw-tcrit]) } } return(semi) } # This function weights the priority vectors representing the influence of the alternatives within the criteria in the Supermatrix # to recombine these vectors with the inner/outer dependence in the original Supermatrix. reweightalt<-function(semi,wght,nlts,tcrit){ for(gw in 1:tcrit){ for(gw1 in (tcrit+1):(tcrit+nlts)){ semi[gw1,gw]=semi[gw1,gw]*wght[gw] } } return(semi) } # This function weights the priority vectors representing the influence of the criteria within the alternatives in the Supermatrix # to recombine these vectors with the inner/outer dependence in the original Supermatrix. reweightcrit<-function(semi,wght,nlts,tcrit){ for(gw in (tcrit+1):(tcrit+nlts)){ for(gw1 in 1:tcrit){ semi[gw1,gw]=semi[gw1,gw]*wght[gw-tcrit] } } return(semi) } #This function simplifies the weighted Supermatrix to be raised to powers to see if there is enough connnectivity #from the alternatives to the criteria and from the alternatives to the criteria to even test for coherence check2step2<-function(check2weightedsuper,nalts,totalcrit){ for(i in 1:totalcrit){ for(j in 1:totalcrit){ check2weightedsuper[i,j]=0 } } for(k in 1:nalts){ for(l in 1:nalts){ check2weightedsuper[totalcrit+k,totalcrit+l]=0 } } return(check2weightedsuper) } ###############HERE IS THE MAIN CODE######################################################################## ############### ######################################################################## # Initializing some new variables to default values to initially enter or use in the while loops worst=0 noimprovement=0 sizegoodcluster=1 thereisagoodclust=0 updatable=100 nupdates=0 allmipv=matrix(c(0,0),1,2) #save original weighted Supermatrix to display at end originalsuper=weightedsuper #save the iterative Supermatrices for user review allsupers=originalsuper #This variable is used as a rudimentary data quality check for the initial weighted Supermatrix qualitycheck=nalts+totalcrit # Basic data quality check for the weighted Supermatrix is the entire weighted Supermatrix at least column stochastic and does # not have absorbing states (sometimes called "sinks" and "tubs") that will cause the Supermatrix to converge to 0 when raised to powers Supermatrixqualitycheck1=initialSupermatrixcheck(weightedsuper,qualitycheck) # alternatives and criteria weights to renormalize and return the entire weighted Supermatrix altcolumnweight=matrix(0,1,totalcrit) critcolumnweight=matrix(0,1,nalts) altcolumnweight=getaltweights(weightedsuper,altcolumnweight,nalts,totalcrit) critcolumnweight=getcritweights(weightedsuper,critcolumnweight,nalts,totalcrit) weightedsuper=reweightalt1(weightedsuper,altcolumnweight,nalts,totalcrit) weightedsuper=reweightcrit1(weightedsuper,critcolumnweight,nalts,totalcrit) check2weightedsuper=weightedsuper check2weightedsuper=check2step2(check2weightedsuper,nalts,totalcrit) # This is another data quality check to make sure there is enough connectivity among the portions of the Supermatrix used to # test for coherency to create the Linking Estimates Supermatrixqualitycheck2=LESupermatrixcheck(check2weightedsuper,qualitycheck) goodenoughdata=Supermatrixqualitycheck1*Supermatrixqualitycheck2 #This is where you can override the dataquality checks and see if the code will still run. Remember to be cautious about #interpreting the results #goodenoughdata=1 if(goodenoughdata==1){ # Step 1a Set the variable LCI.limit to the assigned value from LCI.Steps lcilimit=lcisteps[1] # Step 1b Determine the number of LEs needed in a coherent cluster # note the default values are provided above as a default but if you want to change # the default values in Step 1b then go to line 33 of the code at the top # Initializing other "variables" pagesforcrit=totalcrit pagesforalts=nalts linkingestimatescrit=array(0,c(nalts+totalcrit,nalts+totalcrit,pagesforcrit)) linkingestimatesalts=array(0,c(nalts+totalcrit,nalts+totalcrit,pagesforalts)) # Step 1c Create the linking estimates for (s in 1:totalcrit){ linkingestimatescrit[,,s]=estimates(s,weightedsuper,totalcrit,nalts,altanchor,0) } for (s in 1:nalts){ linkingestimatesalts[,,s]=estimates(s,weightedsuper,totalcrit,nalts,critanchor,1) } # Step 1c Calculate the LCI lciscrit=lcimatrixpieces(0,linkingestimatescrit,nalts,totalcrit) lcisalts=lcimatrixpieces(1,linkingestimatesalts,nalts,totalcrit) # Step 1d Calculate a single LCI score for each alternative and criteria lciscorescrit=lciscores(0,totalcrit,nalts,lciscrit,clustcritcut) lciscoresalts=lciscores(1,totalcrit,nalts,lcisalts,clustaltcut) #Save the original LCI data for user reference at the end originallcicrit=lciscorescrit originallcialts=lciscoresalts alllcicrit=originallcicrit alllcialts=originallcialts # Step 1e Identify the most incoherent priority vector (MIPV) rangelciscorescrit=max(lciscorescrit)-min(lciscorescrit) rangelciscoresalts=max(lciscoresalts)-min(lciscoresalts) maxrange=max(rangelciscorescrit,rangelciscoresalts) altorcrit=ifelse(rangelciscorescrit>rangelciscoresalts,0,1) maxvectorcrit=findamax(0,totalcrit,nalts,lciscorescrit) maxvectoralt=findamax(1,totalcrit,nalts,lciscoresalts) # Step 1f Evaluate if the MIPV is a candidate for updating (part 1 is there a problem or not) possibleproblem=ifelse(altorcrit==0,sum((1:totalcrit)*maxvectorcrit),sum((1:nalts)*maxvectoralt)) problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if(problem==0) { updatable=3 #coherent to begin with } # Step 1f Evaluate if the MIPV is a candidate for updating (part 2 is there a coherent cluster with good enough data) if(altorcrit==0){ orderedlciscorescrit=sort(lciscorescrit,decreasing=FALSE) rb=orderedlciscorescrit[clustcritcut] clusterrange=orderedlciscorescrit[1]-rb } else{ orderedlciscoresalts=sort(lciscoresalts,decreasing=FALSE) rb=orderedlciscoresalts[clustaltcut] clusterrange=orderedlciscoresalts[1]-rb } # raisebar is the value of the worst entry in the smallest cluster needed to be able to cluster ##used for 2 things??## raisebar=rb # Assigning worst to another variable to use to compare against "worst" that will be calculated when after updating # to test for no improvement and avoid infinite looping worst1=max(max(lciscorescrit),max(lciscoresalts)) # Step 1g Categorize the Supermatrix as Updatable or Not Updatable if(problem!=0){ if(raisebar<=lcisteps[3]){ updatable=1 #updatable } else { updatable=2 #not-updatable } } # Step 2 Update is carried out in the nested loops. With different levels of lcisteps to allow for the stricter levels of # coherency to be used as quickly as possible. if(updatable==1){ while(noimprovement==0 ){ while(raisebar>lcisteps[1] && noimprovement==0 ){ while(raisebar>lcisteps[2] && noimprovement==0 ){ # Step 2 a set LCI limit to respective lcisteps value lcilimit=lcisteps[3] problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if (altorcrit==0) { goodcluster=(1:totalcrit)*ifelse(lciscorescrit=clustcritcut,1,0),ifelse(sizegoodclust>=clustaltcut,1,0)) # Step 2b Update the MIPV if(altorcrit==0 && problem!=0 && thereisagoodclust==1){ updatewiththis=apply(linkingestimatescrit[(1+totalcrit):(nalts+totalcrit),problem,goodcluster],1,mean) weightedsuper[(1+totalcrit):(nalts+totalcrit),problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } else if(altorcrit==1 && problem!=0 && thereisagoodclust==1) { updatewiththis=apply(linkingestimatesalts[1:totalcrit,totalcrit+problem,goodcluster],1,mean) weightedsuper[1:totalcrit,totalcrit+problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } # Step 2c repeat steps 1c-1f for (s in 1:totalcrit){ linkingestimatescrit[,,s]=estimates(s,weightedsuper,totalcrit,nalts,altanchor,0) } for (s in 1:nalts){ linkingestimatesalts[,,s]=estimates(s,weightedsuper,totalcrit,nalts,critanchor,1) } lciscrit=lcimatrixpieces(0,linkingestimatescrit,nalts,totalcrit) lcisalts=lcimatrixpieces(1,linkingestimatesalts,nalts,totalcrit) lciscorescrit=lciscores(0,totalcrit,nalts,lciscrit,clustcritcut) lciscoresalts=lciscores(1,totalcrit,nalts,lcisalts,clustaltcut) alllcicrit=rbind(alllcicrit,lciscorescrit) alllcialts=rbind(alllcialts,lciscoresalts) rangelciscorescrit=max(lciscorescrit)-min(lciscorescrit) rangelciscoresalts=max(lciscoresalts)-min(lciscoresalts) maxrange=max(rangelciscorescrit,rangelciscoresalts) altorcrit=ifelse(rangelciscorescrit>rangelciscoresalts,0,1) maxvectorcrit=findamax(0,totalcrit,nalts,lciscorescrit) maxvectoralt=findamax(1,totalcrit,nalts,lciscoresalts) possibleproblem=ifelse(altorcrit==0,sum((1:totalcrit)*maxvectorcrit),sum((1:nalts)*maxvectoralt)) problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if(altorcrit==0){ orderedlciscorescrit=sort(lciscorescrit,decreasing=FALSE) rb=orderedlciscorescrit[clustcritcut] clusterrange=orderedlciscorescrit[1]-rb } else{ orderedlciscoresalts=sort(lciscoresalts,decreasing=FALSE) rb=orderedlciscoresalts[clustaltcut] clusterrange=orderedlciscoresalts[1]-rb } raisebar=rb # Step 2d check for improvement. And Step 2e Repeat steps 2b-2d in loop worst=min(min(lciscorescrit),min(lciscoresalts)) noimprovement=ifelse(worst1==worst,1,0) worst1=worst } # Step 2d update LCI Limit lcilimit=lcisteps[2] # Step 2e Repeat steps 2b-2d problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if (altorcrit==0) { goodcluster=(1:totalcrit)*ifelse(lciscorescrit=clustcritcut,1,0),ifelse(sizegoodclust>=clustaltcut,1,0)) if(altorcrit==0 && problem!=0 && thereisagoodclust==1){ updatewiththis=apply(linkingestimatescrit[(1+totalcrit):(nalts+totalcrit),problem,goodcluster],1,mean) weightedsuper[(1+totalcrit):(nalts+totalcrit),problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } else if(altorcrit==1 && problem!=0 && thereisagoodclust==1) { updatewiththis=apply(linkingestimatesalts[1:totalcrit,totalcrit+problem,goodcluster],1,mean) weightedsuper[1:totalcrit,totalcrit+problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } for (s in 1:totalcrit){ linkingestimatescrit[,,s]=estimates(s,weightedsuper,totalcrit,nalts,altanchor,0) } for (s in 1:nalts){ linkingestimatesalts[,,s]=estimates(s,weightedsuper,totalcrit,nalts,critanchor,1) } lciscrit=lcimatrixpieces(0,linkingestimatescrit,nalts,totalcrit) lcisalts=lcimatrixpieces(1,linkingestimatesalts,nalts,totalcrit) lciscorescrit=lciscores(0,totalcrit,nalts,lciscrit,clustcritcut) lciscoresalts=lciscores(1,totalcrit,nalts,lcisalts,clustaltcut) alllcicrit=rbind(alllcicrit,lciscorescrit) alllcialts=rbind(alllcialts,lciscoresalts) rangelciscorescrit=max(lciscorescrit)-min(lciscorescrit) rangelciscoresalts=max(lciscoresalts)-min(lciscoresalts) maxrange=max(rangelciscorescrit,rangelciscoresalts) altorcrit=ifelse(rangelciscorescrit>rangelciscoresalts,0,1) maxvectorcrit=findamax(0,totalcrit,nalts,lciscorescrit) maxvectoralt=findamax(1,totalcrit,nalts,lciscoresalts) possibleproblem=ifelse(altorcrit==0,sum((1:totalcrit)*maxvectorcrit),sum((1:nalts)*maxvectoralt)) problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if(altorcrit==0){ orderedlciscorescrit=sort(lciscorescrit,decreasing=FALSE) rb=orderedlciscorescrit[clustcritcut] clusterrange=orderedlciscorescrit[1]-rb } else{ orderedlciscoresalts=sort(lciscoresalts,decreasing=FALSE) rb=orderedlciscoresalts[clustaltcut] clusterrange=orderedlciscoresalts[1]-rb } raisebar=rb worst=min(min(lciscorescrit),min(lciscoresalts)) noimprovement=ifelse(worst1==worst,1,0) worst1=worst } lcilimit=lcisteps[1] problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if (altorcrit==0) { goodcluster=(1:totalcrit)*ifelse(lciscorescrit=clustcritcut,1,0),ifelse(sizegoodclust>=clustaltcut,1,0)) if(altorcrit==0 && problem!=0 && thereisagoodclust==1){ updatewiththis=apply(linkingestimatescrit[(1+totalcrit):(nalts+totalcrit),problem,goodcluster],1,mean) weightedsuper[(1+totalcrit):(nalts+totalcrit),problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } else if(altorcrit==1 && problem!=0 && thereisagoodclust==1) { updatewiththis=apply(linkingestimatesalts[1:totalcrit,totalcrit+problem,goodcluster],1,mean) weightedsuper[1:totalcrit,totalcrit+problem]=updatewiththis allsupers=rbind(allsupers,rep(NA,nalts+totalcrit)) allsupers=rbind(allsupers,weightedsuper) nupdates=nupdates+1 allmipv=rbind(allmipv,c(altorcrit,problem)) } for (s in 1:totalcrit){ linkingestimatescrit[,,s]=estimates(s,weightedsuper,totalcrit,nalts,altanchor,0) } for (s in 1:nalts){ linkingestimatesalts[,,s]=estimates(s,weightedsuper,totalcrit,nalts,critanchor,1) } lciscrit=lcimatrixpieces(0,linkingestimatescrit,nalts,totalcrit) lcisalts=lcimatrixpieces(1,linkingestimatesalts,nalts,totalcrit) lciscorescrit=lciscores(0,totalcrit,nalts,lciscrit,clustcritcut) lciscoresalts=lciscores(1,totalcrit,nalts,lcisalts,clustaltcut) alllcicrit=rbind(alllcicrit,lciscorescrit) alllcialts=rbind(alllcialts,lciscoresalts) rangelciscorescrit=max(lciscorescrit)-min(lciscorescrit) rangelciscoresalts=max(lciscoresalts)-min(lciscoresalts) maxrange=max(rangelciscorescrit,rangelciscoresalts) altorcrit=ifelse(rangelciscorescrit>rangelciscoresalts,0,1) maxvectorcrit=findamax(0,totalcrit,nalts,lciscorescrit) maxvectoralt=findamax(1,totalcrit,nalts,lciscoresalts) possibleproblem=ifelse(altorcrit==0,sum((1:totalcrit)*maxvectorcrit),sum((1:nalts)*maxvectoralt)) problem=ifelse(altorcrit==0,ifelse(max(lciscorescrit)>lcilimit,possibleproblem,0),ifelse(max(lciscoresalts)>lcilimit,possibleproblem,0)) if(altorcrit==0){ orderedlciscorescrit=sort(lciscorescrit,decreasing=FALSE) rb=orderedlciscorescrit[clustcritcut] clusterrange=orderedlciscorescrit[1]-rb } else{ orderedlciscoresalts=sort(lciscoresalts,decreasing=FALSE) rb=orderedlciscoresalts[clustaltcut] clusterrange=orderedlciscoresalts[1]-rb } raisebar=rb worst=min(min(lciscorescrit),min(lciscoresalts)) noimprovement=ifelse(worst1==worst,1,0) worst1=worst } } weightedsuper=reweightalt(weightedsuper,altcolumnweight,nalts,totalcrit) weightedsuper=reweightcrit(weightedsuper,critcolumnweight,nalts,totalcrit) limitmatrix=raisepowers(weightedsuper,powersuper) # Step 2f Report the Results # print out/provide info under 3 scenarios 1) good to begin with 2) updatable 3) not updatable #Some formatting to make the results more readable lciscorescrit=matrix(lciscorescrit,1,totalcrit) colnames(lciscorescrit)=sprintf("Crit%d", 1:totalcrit) lciscoresalts=matrix(lciscoresalts,1,nalts) colnames(lciscoresalts)=sprintf("Alt%d", 1:nalts) #Printing results to the screen if(updatable==3){ print("Your original Supermatrix is coherent!") cat("\n") print("LCI scores for the alternatives:") print(alllcialts) cat("\n") print("LCI scores for the criteria:") print(alllcicrit) cat("\n") print("Your limit matrix is:") print(limitmatrix) cat("\n") print("To save the original Supermatrix, use:") print("write.table(allsupers,'C:/(fill in where you want it)/allsupers.txt', sep='\t',row.names = FALSE,)") cat("\n") print("To save the limit Supermatrix, use:") print("write.table(limitmatrix,'C:/(fill in where you want it)/limitmatrix.txt', sep='\t',row.names = FALSE,)") cat("\n") print("To save the original LCI-scores, use:") print("write.table(alllcicrit,'C:/(fill in where you want it)/alllcicrit.txt', sep='\t',row.names = FALSE,)") print("write.table(alllcialts,'C:/(fill in where you want it)/alllcialts.txt', sep='\t',row.names = FALSE,)") } if(updatable==2){ print("Your original Supermatrix is incoherent and cannot be updated automatically.") cat("\n") print("You can try increasing the maximum LCI.steps value and re-running the code again to see if the algorithm") cat("\n") print("can find a good cluster for that level. However, keep in mind that increasing the maximum LCI.steps value") cat("\n") print("will eventually result in garbage-in, garbage-out!") cat("\n") print("Another possible solution is to perform the cluster weighting individually for each column in the Supermatrix.") cat("\n") print("LCI scores for the alternatives:") print(alllcialts) cat("\n") print("LCI scores for the criteria:") print(alllcicrit) cat("\n") print("To save the original Supermatrix, use:") print("write.table(allsupers,'C:/(fill in where you want it)/allsupers.txt', sep='\t',row.names = FALSE,)") cat("\n") print("To save the original LCI-scores, use:") print("write.table(alllcicrit,'C:/(fill in where you want it)/alllcicrit.txt', sep='\t',row.names = FALSE,)") print("write.table(alllcialts,'C:/(fill in where you want it)/alllcialts.txt', sep='\t',row.names = FALSE,)") } if(updatable==1){ print("Your original Supermatrix was incoherent and has been updated automatically.") cat("\n") print("Initial Supermatrix:") print(originalsuper) cat("\n") print("Initial LCI scores for the alternatives:") print(originallcialts) cat("\n") print("Initial LCI scores for the criteria:") print(originallcicrit) cat("\n") print("Suggested Supermatrix:") print(weightedsuper) cat("\n") print("Number of updates made to your Supermatrix:") print(nupdates) cat("\n") cat("The MIPVs that were updated: (Note: The first column identifies if the MIPV was in the alternative cluster (1) or the criteria cluster(s) (0).") cat("The second column is the respective entry in either the alternative or criteria cluster(s).") print(allmipv[2:nrow(allmipv),]) cat("\n") print("Final LCI scores for the alternatives:") print(lciscoresalts) cat("\n") print("Final LCI scores for the criteria:") print(lciscorescrit) cat("\n") print("Your limit matrix is:") print(limitmatrix) cat("\n") cat("To save the original Supermatrix along with the updated ones, use: (A row of NA's will appear after each Supermatrix)") print("write.table(allsupers,'C:/(fill in where you want it)/allsupers.txt', sep='\t',row.names = FALSE,)") cat("\n") print("To save the limit Supermatrix, use:") print("write.table(limitmatrix,'C:/(fill in where you want it)/limitmatrix.txt', sep='\t',row.names = FALSE,)") cat("\n") print("To save the original LCI-scores along with the LCI-scores of the suggested updates, use:") print("write.table(alllcicrit,'C:/(fill in where you want it)/alllcicrit.txt', sep='\t',row.names = FALSE,)") print("write.table(alllcialts,'C:/(fill in where you want it)/alllcialts.txt', sep='\t',row.names = FALSE,)") } } if(goodenoughdata==0){ cat("If you see this output there was probably a problem with the initial data.") cat("\n") cat("Scroll back up to find the printed message(s) with more information.") cat("\n") }