Multi Objective Decision Analysis in R

Prereqs

This tutorial uses the DecisionAnalysis::NFLcombine dataset that came from NFLSavant.com. This is a database consisting of NFL Combine data from 1999 to 2015 and is documented in ?DecisionAnalysis::NFLcombine. This tutorial also requires the following packages:

knitr::opts_chunk$set(collapse = TRUE, 
                      fig.align = "center",
                      options(bitmapType='cairo'))
library(dplyr)
library(gridExtra)
library(knitr)
library(Cairo)

Overview

Multi-Objective Decision Analysis (MODA) is a process for making decisions when there are very complex issues involving multiple criteria and multiple parties who may be deeply affected by the outcomes of the decisions.

Using MODA allows individuals to consider and weight factors and trade-offs while evaluating each alternative (in this case, quarterbacks entering the draft). The individuals are then able to discuss the results and trade offs to help decide on a recommendation.

Currently there is very little out there for any multi criteria decision making in R.

• MCMD: Package containing different methods for weighting and calculating of alternatives. Must calculate SAVF matrix before utilizing, offers no sensitivity analysis.
• KraljicMatrix: Solves a specific instance of MCDM, but is not reproducible for other problems.

MODA Method

MODA consists of ten steps. In this tutorial, we will cover the bolded steps in greater detail.

1. Problem Identification

2. Identifing and Structuring Objectives

3. Measuring the Achievement of Objectives

4. Single Attribute Value Functions

5. Multi Attribute Value Functions

6. Alternative Generation and Screening

7. Alternative Scoring

8. Determanistic Sensitivity

9. Sensitivity Analysis

10. Communicating Results

Test Data Set

Throughout this tutorial we will use a subset of the NFL Combine data so that it is a reasonable amount to work with. We will limit the data set to quarterbacks from 2011 who have a Wonderlic score, and we will retain their name, height, weight, forty yard dash, shuttle sprint, vertical jump, broad jump, Wonderlic, and draft round. This is referred to as the raw data.

qbdata <- DecisionAnalysis::NFLcombine %>%
    filter(year == '2011', position == 'QB', wonderlic != '0') %>%
  select(c(2, 8, 9, 12, 15, 17, 18, 25, 20))  
qbdata[qbdata == 0] = NA
names(qbdata) <- c("Name", "Height", "Weight", "Forty", 
                     "Shuttle", "Vertical", "Broad", "Wonderlic", "Round")

Value Hierarchy

A value hierarchy is a way to depict what is important to the decision maker(s) when choosing from the list of alternatives. Objectives are the evaluation considerations that are deemed to be important. Each objective is broken down until it can be measured by a single evaluation measure. In this example the value_hierarchy_tree function from the DecisionAnalysis package is used and the evaluation measures are the measurement criteria (height, weight, etc.) that we retained from the database.

branches<- as.data.frame(matrix(ncol=4,nrow=7))
names(branches)<-c("Level1","Level2","Level3","leaves")
branches[1,]<-rbind("QB","Elusiveness","Speed","Forty")
branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle")
branches[3,]<-rbind("QB","Size","","Height")
branches[4,]<-rbind("QB","Size","","Weight")
branches[5,]<-rbind("QB","Intelligence","","Wonderlic")
branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical")
branches[7,]<-rbind("QB","Strength","Power","Broad")

DecisionAnalysis::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3,
leaves=branches$leaves, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White")

Value Measures

Taking the evaluation measures that were determined from the value hierarchy, high and low bounds are determined for each criteria. End points are limited to those that fell within the “acceptable” region. This allows us to convert raw data into a criteria score in the next step.

Below shows the table of value measures for out test data set:

Single Attribute Value Function

Single Value Attribute Functions (SAVF) are used to calculate an individual criteria score from the raw data. The three types of SAVFs are exponential, linear, and categorical. The SAVFs can be either increasing or decreasing.

The bisection technique was used for the linear and exponential SAVFs. To find the bisection, or mid-value point, the decision maker is asked to identify the halfway mark for each value measurement. Below is an example of the three plots using the three DecisionAnalysis SAVF plot functions:

a1 <- DecisionAnalysis::SAVF_exp_plot(90, 0, 120, 150)
a2 <- DecisionAnalysis::SAVF_linear_plot(10, 0, 20, 100, FALSE)
a3 <- DecisionAnalysis::SAVF_cat_plot(c("Tom", "Bill", "Jerry"), c(0.1, 0.25, 0.65))
gridExtra::grid.arrange(a1, a2, a3, ncol = 2)

SAVF Matrix

For our test data set, the exponential SAVF was used with the mid point of each criteria being the mean value of all drafted quarterbacks. The exponential SAVFs were calculated for each criteria using the DecisionAnalysis SAVF_exp_score function then put into a matrix using cbind. The SAVF_linear_score and SAVF_categorical_score are additional functions that can be used in place of SAVF_exp_score, where applicable.

Below is the SAVF matrix for the test data set:

Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3)
Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3)
Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3)
Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3)
Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3)
Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3)
Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3)

SAVF_matrix = cbind(qbdata$Name, Height, Weight, Forty, Shuttle, 
                    Vertical, Broad, Wonderlic)
SAVF_matrix[is.na(SAVF_matrix)] <- 0

knitr::kable(SAVF_matrix, caption = "SAVF Scores")

Multi Attribute Value Function

The final step in determining the alternative’s score is to calculate the Multi Attribute Value Function (MAVF) score. This can be done using a variety of different methods, the simplest being the use of a weight vector that multiplies each attribute’s SAVF by some relative measure of importance. The weights vector is normalized so that the sum of weights is equal to one. The value_hierarchy_tree function from a previous example is used again here, but with a weights input. The weights for the test set is below:

branches<- as.data.frame(matrix(ncol=5,nrow=7))
names(branches)<-c("Level1","Level2","Level3","leaves","weights")
branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092")
branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138")
branches[3,]<-rbind("QB","Size","","Height","0.096")
branches[4,]<-rbind("QB","Size","","Weight","0.224")
branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07")
branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152")
branches[7,]<-rbind("QB","Strength","Power","Broad","0.228")

DecisionAnalysis::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3,
leaves=branches$leaves,weights=branches$weights, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White")

MAVF Scores

The MAVF scores were calculated using the MAVF_Scores function which take the SAVF matrix and multiplies each SAVF score by the associated weight and summing all weighted scores for each alternative returning a single alternative score.

For example, taking Cam Newton from the test data set:

(0.096)(0.63)+(0.224)(0.75)+(0.092)(0.737)+(0.14)(0.613)+(0.15)(0.67)+(0.23)(0.89)+(0.07)(0.38) = 0.712

Below shows all values from our test data set using the MAVF_Scores function:

Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3)
Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3)
Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3)
Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3)
Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3)
Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3)
Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3)

SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 
                    Vertical, Broad, Wonderlic)
weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07)
names = qbdata$Name

MAVF <- DecisionAnalysis::MAVF_Scores(SAVF_matrix, weights, names)
knitr::kable(MAVF, digits = 4, row.names = FALSE, caption = "MAVF Scores")

Breakout Graph

After the alternatives were scored, initial analysis is conducted to ensure the rankings are easily understandable and to see if there are any insights or improvements that can be identified. This is done by looking at the deterministic sensitivity of each alternative.

The value breakout graph allows for a quick and easy comparison of how each attribute affected the alternatives. Using the DecisionAnalysis MAVF_breakout function the breakout graph below was created from the test data:

Height <- DecisionAnalysis::SAVF_exp_score(qbdata$Height, 68, 75.21, 82, 1)
Weight <- DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275, 1)
Forty <- DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, 2)
Shuttle <- DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, 2)
Vertical <- DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40, 1)
Broad <- DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130, 1)
Wonderlic <- DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50, 1)
  
SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 
                      Vertical, Broad, Wonderlic)
weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07)
names = qbdata$Name

DecisionAnalysis::MAVF_breakout(SAVF_matrix, weights, names)

MAVF Breakout Graph

Sensitivity Analysis

Once it is concluded that the model is valid, sensitivity analysis is conducted to determine the impact on the rankings of alternatives to changes in the various assumptions of the model, specifically the weights. The weights represent the relative importance that is attached to each evaluation measure. Using the DecisionAnalysis sensitivity_plot function, the sensitivity analysis plot for the shuttle criteria in the test set is below:

Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3)
Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3)
Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3)
Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3)
Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3)
Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3)
Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3)

SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 
                    Vertical, Broad, Wonderlic)
  
weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07)

DecisionAnalysis::sensitivity_plot(SAVF_matrix, weights, qbdata$Name, 4)

Sensitivity Analysis

Practice Problems

1. Change the year to “2004”, how many quarterbacks were at the combine?

2. Calculate the MAVF scores and include the round the QB was drafted, who was the highest ranked?

3. Does anything seem out of place?

References

Kirkwood, Craig W. Strategic Decision Making. Wadsworth Publishing Company, 1997.