├── data └── NFLcombine.rda ├── tests ├── testthat.R └── testthat │ ├── test_SAVF_categorical_plot.R │ ├── test_SAVF_linear_plot.R │ ├── test_SAVF_exp_plot.R │ ├── test_SAVF_calc_rho.R │ ├── test_SAVF_exp_score.R │ ├── test_SAVF_linear_score.R │ ├── test_SAVF_categorical_score.R │ ├── test_value_hierarchy_tree.R │ ├── test_MAVF_breakout.R │ ├── test_sensitivity_plot.R │ └── test_MAVF_scores.R ├── .gitignore ├── .Rbuildignore ├── .travis.yml ├── R ├── onattach.R ├── SAVF_categorical_plot.R ├── SAVF_categorical_score.R ├── SAVF_linear_score.R ├── SAVF_exp_score.R ├── data.R ├── SAVF_calc_rho.R ├── SAVF_linear_plot.R ├── MAVF_scores.R ├── DecisionAnalysis_package.R ├── SAVF_exp_plot.R ├── MAVF_breakout.R ├── sensitivity_plot.R └── value_hierarchy_tree.R ├── DecisionAnalysis.Rproj ├── cran-comments.md ├── cran-comments.Rmd ├── man ├── SAVF_categorical_score.Rd ├── SAVF_calc_rho.Rd ├── SAVF_cat_plot.Rd ├── SAVF_linear_score.Rd ├── SAVF_linear_plot.Rd ├── SAVF_exp_score.Rd ├── SAVF_exp_plot.Rd ├── MAVF_Scores.Rd ├── MAVF_breakout.Rd ├── sensitivity_plot.Rd ├── NFLcombine.Rd ├── value_hierarchy_tree.Rd └── DecisionAnalysis-package.Rd ├── NAMESPACE ├── DESCRIPTION ├── README.md ├── README.Rmd ├── inst └── doc │ ├── MultiObjectiveDecisionAnalysisinR.R │ └── MultiObjectiveDecisionAnalysisinR.Rmd └── vignettes └── MultiObjectiveDecisionAnalysisinR.Rmd /data/NFLcombine.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AFIT-R/DecisionAnalysis/HEAD/data/NFLcombine.rda -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(DecisionAnalysis) 3 | 4 | test_check("DecisionAnalysis") -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | src/*.dll 6 | src/*.o 7 | src/*.so 8 | /revdep/.cache.rds 9 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | README.Rmd 4 | README.md 5 | ^\.travis\.yml$ 6 | ^.*\.dll$ 7 | ^.*\.o$ 8 | ^revdep$ 9 | cran-comments.md 10 | cran-comments.Rmd 11 | -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_categorical_plot.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_cat_plot provides proper messages and warnings",{ 2 | expect_error(SAVF_cat_plot(c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.60))) 3 | expect_error(SAVF_cat_plot(c("Tom", "Bill" ,"Jerry"), c(0.1, 0.65, 0.65))) 4 | }) -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | sudo: required 5 | cache: packages 6 | before_install: 7 | - sudo apt-get install libgmp3-dev 8 | 9 | r_packages: 10 | - covr 11 | 12 | after_success: 13 | - Rscript -e 'library(covr); codecov()' -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_linear_plot.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_linear_plot provides proper messages and warnings",{ 2 | expect_error(SAVF_linear_plot(70, 68, 85, 82, TRUE)) 3 | expect_error(SAVF_linear_plot(74, 90, 79, 82, TRUE)) 4 | expect_error(SAVF_linear_plot(74, 90, 79, 95, FALSE)) 5 | expect_error(SAVF_linear_plot(74, 90, 91, 88, FALSE)) 6 | }) -------------------------------------------------------------------------------- /R/onattach.R: -------------------------------------------------------------------------------- 1 | #' @importFrom stats runif 2 | 3 | .onAttach <- function(...) { 4 | 5 | # If interactive, hide message 6 | # o.w. check against rng seed. 7 | if (!interactive() || stats::runif(1) > 0.5){ 8 | return() 9 | } 10 | 11 | # Display hint 12 | packageStartupMessage( "To see the user guide use `browseVignettes('DecisionAnalysis')`") 13 | } -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_exp_plot.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_exp_plot provides proper messages and warnings",{ 2 | expect_error(SAVF_exp_plot(70, 68, 85, 82, TRUE)) 3 | expect_error(SAVF_exp_plot(74, 90, 79, 82, TRUE)) 4 | expect_error(SAVF_exp_plot(74, 90, 79, 95, FALSE)) 5 | expect_error(SAVF_exp_plot(74, 90, 91, 88, FALSE)) 6 | expect_error(SAVF_exp_plot(74, 68, 75, 82, FALSE)) 7 | }) 8 | -------------------------------------------------------------------------------- /DecisionAnalysis.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | 2 | Test environments 3 | ----------------- 4 | 5 | - local win install, R 3.4.3 6 | - ubuntu 14.04.5 (on travis-ci), R 3.4.2 7 | - Ubuntu Linux 16.04 LTS, R-release, GCC (on rhub) 8 | - Windows Server 2008 R2 SP1, R-devel, 32/64 bi (on rhub) 9 | 10 | R CMD check results 11 | ------------------- 12 | 13 | There were no NOTES, ERRORs or WARNINGs. 14 | 15 | Downstream dependencies 16 | ----------------------- 17 | 18 | There are currently no downstream dependencies of DecisionAnalysis. 19 | -------------------------------------------------------------------------------- /cran-comments.Rmd: -------------------------------------------------------------------------------- 1 | 2 | --- 3 | output: 4 | md_document: 5 | variant: markdown_github 6 | --- 7 | 8 | 9 | 10 | ```{r, echo = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.path = "cran-comments-" 15 | ) 16 | ``` 17 | 18 | 19 | ## Test environments 20 | * local win install, R 3.4.3 21 | * ubuntu 14.04.5 (on travis-ci), R 3.4.2 22 | * Ubuntu Linux 16.04 LTS, R-release, GCC (on rhub) 23 | * Windows Server 2008 R2 SP1, R-devel, 32/64 bi (on rhub) 24 | 25 | ## R CMD check results 26 | There were no NOTES, ERRORs or WARNINGs. 27 | 28 | ## Downstream dependencies 29 | There are currently no downstream dependencies of DecisionAnalysis. -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_calc_rho.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_calc_rho provides proper messages and warnings",{ 2 | expect_error(SAVF_calc_rho(68, 86, 82, TRUE)) 3 | expect_error(SAVF_calc_rho(90, 79, 82, TRUE)) 4 | expect_error(SAVF_calc_rho(90, 79, 95, FALSE)) 5 | expect_error(SAVF_calc_rho(90, 91, 88, FALSE)) 6 | expect_error(SAVF_calc_rho(68, 75, 82, TRUE)) 7 | }) 8 | 9 | test_that("SAVF_calc_rho has correct dimensions and output type",{ 10 | expect_is(SAVF_calc_rho(0, 90, 150, FALSE),"numeric") 11 | expect_length(SAVF_calc_rho(0, 45, 100, TRUE),1) 12 | }) 13 | 14 | test_that("SAVF_exp_score computes correctly",{ 15 | expect_equal(round(SAVF_calc_rho(0, 90, 150, FALSE),4),182.4465) 16 | expect_equal(round(SAVF_calc_rho(15, 100, 200, TRUE),4),567.9176) 17 | }) 18 | -------------------------------------------------------------------------------- /man/SAVF_categorical_score.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_categorical_score.R 3 | \name{SAVF_categorical_score} 4 | \alias{SAVF_categorical_score} 5 | \title{Single Attribute Value Function (SAVF) Categorical Score} 6 | \usage{ 7 | SAVF_categorical_score(x, categories, weights) 8 | } 9 | \arguments{ 10 | \item{x}{Attribute raw value} 11 | 12 | \item{categories}{Vector of categories} 13 | 14 | \item{weights}{Numeric vector of category weights} 15 | } 16 | \value{ 17 | Categorical SAVF Score 18 | } 19 | \description{ 20 | : Calculates the Single Attribute Value Function (SAVF) score for a categorical value. 21 | } 22 | \examples{ 23 | \dontrun{ SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65))} 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/SAVF_calc_rho.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_calc_rho.R 3 | \name{SAVF_calc_rho} 4 | \alias{SAVF_calc_rho} 5 | \title{Single Attribute Value Function (SAVF) Calculate Rho} 6 | \usage{ 7 | SAVF_calc_rho(x_low, x_mid, x_high, increasing = TRUE) 8 | } 9 | \arguments{ 10 | \item{x_low}{Lowest value} 11 | 12 | \item{x_mid}{Midpoint value} 13 | 14 | \item{x_high}{Highest value} 15 | 16 | \item{increasing}{TRUE=increasing, FALSE=decreasing, Default: TRUE} 17 | } 18 | \value{ 19 | Rho 20 | } 21 | \description{ 22 | : Calculates rho for an exponential function. 23 | } 24 | \details{ 25 | For Z=((x_mid - x_low) / (x_high - x_low)), 26 | Z can not be in (0.51,0.49) 27 | } 28 | \examples{ 29 | \dontrun{ SAVF_calc_rho(0, 90, 150, FALSE)} 30 | 31 | } 32 | -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_exp_score.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_exp_score provides proper messages and warnings",{ 2 | expect_error(SAVF_exp_score(70, 68, 85, 82, TRUE)) 3 | expect_error(SAVF_exp_score(74, 90, 79, 82, TRUE)) 4 | expect_error(SAVF_exp_score(74, 90, 79, 95, FALSE)) 5 | expect_error(SAVF_exp_score(74, 90, 91, 88, FALSE)) 6 | expect_error(SAVF_exp_score(74, 68, 75, 82, FALSE)) 7 | }) 8 | 9 | test_that("SAVF_exp_score has correct dimensions and output type",{ 10 | expect_is(SAVF_exp_score(70, 0, 90, 150, FALSE),"numeric") 11 | expect_length(SAVF_exp_score(70, 0, 60, 133, TRUE),1) 12 | }) 13 | 14 | 15 | test_that("SAVF_exp_score computes correctly",{ 16 | expect_equal(round(SAVF_exp_score(74, 68, 75.21, 82, TRUE), 3),0.414) 17 | expect_equal(round(SAVF_exp_score(4.18, 3.8, 4.3, 4.9, FALSE), 3),0.613) 18 | }) 19 | -------------------------------------------------------------------------------- /man/SAVF_cat_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_categorical_plot.R 3 | \name{SAVF_cat_plot} 4 | \alias{SAVF_cat_plot} 5 | \title{Single Attribute Value Function (SAVF) Categorical Plot} 6 | \usage{ 7 | SAVF_cat_plot(categories, scores, fillcolor = "blue") 8 | } 9 | \arguments{ 10 | \item{categories}{Vector of categories} 11 | 12 | \item{scores}{Numeric vector of catgory scores} 13 | 14 | \item{fillcolor}{Fill color for the chart, default is blue} 15 | } 16 | \value{ 17 | Categorical SAVF graph 18 | } 19 | \description{ 20 | : Plots the categorical Single Attribute Value Function (SAVF) graph. Categories may be any value, but category scores must be numeric. 21 | The function checks to ensure the total of scores sums to one. 22 | } 23 | \examples{ 24 | \dontrun{ SAVF_cat_plot(c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65))} 25 | 26 | } 27 | -------------------------------------------------------------------------------- /man/SAVF_linear_score.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_linear_score.R 3 | \name{SAVF_linear_score} 4 | \alias{SAVF_linear_score} 5 | \title{Single Attribute Value Function (SAVF) Linear Score} 6 | \usage{ 7 | SAVF_linear_score(x, x_low, x_mid, x_high, increasing = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{Attribute raw value} 11 | 12 | \item{x_low}{Lowest value} 13 | 14 | \item{x_mid}{Midpoint value} 15 | 16 | \item{x_high}{Highest value} 17 | 18 | \item{increasing}{TRUE=increasing, FALSE=decreasing, Default: TRUE} 19 | } 20 | \value{ 21 | Linear SAVF Score 22 | } 23 | \description{ 24 | : Calculates the Single Attribute Value Function (SAVF) score for a linearly increasing or decreasing function. 25 | It calculates the score based on the midpoint value method. 26 | } 27 | \examples{ 28 | \dontrun{ SAVF_linear_score(10, 0, 25, 100, FALSE)} 29 | 30 | } 31 | -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_linear_score.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_linear_score provides proper messages and warnings",{ 2 | expect_error(SAVF_linear_score(70, 68, 85, 82, TRUE)) 3 | expect_error(SAVF_linear_score(74, 90, 79, 82, TRUE)) 4 | expect_error(SAVF_linear_score(74, 90, 79, 95, FALSE)) 5 | expect_error(SAVF_linear_score(74, 90, 91, 88, FALSE)) 6 | }) 7 | 8 | test_that("SAVF_linear_score has correct dimensions and output type",{ 9 | expect_is(SAVF_linear_score(10, 0, 25, 100, FALSE),"numeric") 10 | expect_length(SAVF_linear_score(12, 0, 15, 85, TRUE),1) 11 | }) 12 | 13 | test_that("SAVF_linear_score computes correctly",{ 14 | expect_equal(round(SAVF_linear_score(10, 0, 25, 100), 1),0.2) 15 | expect_equal(round(SAVF_linear_score(5, 2, 7, 12, FALSE), 1),0.7) 16 | expect_equal(round(SAVF_linear_score(30, 0, 25, 100), 1),0.5) 17 | expect_equal(round(SAVF_linear_score(9, 2, 7, 12, FALSE), 1),0.3) 18 | }) -------------------------------------------------------------------------------- /tests/testthat/test_SAVF_categorical_score.R: -------------------------------------------------------------------------------- 1 | test_that("SAVF_categorical_score provides proper messages and warnings",{ 2 | expect_error(SAVF_categorical_score("Tom", c("Will", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65))) 3 | expect_warning(SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.60))) 4 | expect_warning(SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.65, 0.65))) 5 | }) 6 | 7 | test_that("SAVF_categorical_score has correct dimensions and output type",{ 8 | expect_is(SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65)),"numeric") 9 | expect_length(SAVF_categorical_score("Lucille", c("Lucille","Rose","Wilma"), c(0.2, 0.25, 0.55)),1) 10 | }) 11 | 12 | test_that("SAVF_categorical_score computes correctly",{ 13 | expect_equal(SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65)),0.1) 14 | expect_equal(SAVF_categorical_score("9", c("5", "3" ,"9"), c(0.1, 0.25, 0.65)),0.65) 15 | }) -------------------------------------------------------------------------------- /man/SAVF_linear_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_linear_plot.R 3 | \name{SAVF_linear_plot} 4 | \alias{SAVF_linear_plot} 5 | \title{Single Attribute Value Function (SAVF) Linear Plot} 6 | \usage{ 7 | SAVF_linear_plot(x, x_low, x_mid, x_high, increasing = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{Attribute raw value} 11 | 12 | \item{x_low}{Lowest value} 13 | 14 | \item{x_mid}{Midpoint value} 15 | 16 | \item{x_high}{Highest value} 17 | 18 | \item{increasing}{TRUE=increasing, FALSE=decreasing, Default: TRUE} 19 | } 20 | \value{ 21 | Linear SAVF curve with attribute plotted 22 | } 23 | \description{ 24 | : Plots the linear Single Attribute Value Function (SAVF) graph for an increasing or decreasing function. 25 | It calls the SAVF_linear_score function to calculate the score based on the midpoint value method and plots it with a blue dot. 26 | } 27 | \examples{ 28 | \dontrun{ SAVF_linear_plot(10, 0, 25, 100, FALSE)} 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/SAVF_exp_score.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_exp_score.R 3 | \name{SAVF_exp_score} 4 | \alias{SAVF_exp_score} 5 | \title{Single Attribute Value Function (SAVF) Exponential Score} 6 | \usage{ 7 | SAVF_exp_score(x, x_low, x_mid, x_high, increasing = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{Attribute raw value} 11 | 12 | \item{x_low}{Lowest value} 13 | 14 | \item{x_mid}{Midpoint value} 15 | 16 | \item{x_high}{Highest value} 17 | 18 | \item{increasing}{TRUE=increasing, FALSE=decreasing, Default: TRUE} 19 | } 20 | \value{ 21 | Exponential SAVF Score 22 | } 23 | \description{ 24 | : Calculates the Single Attribute Values Function (SAVF) score for an exponentially increasing or decreasing function. 25 | It calls the SAVF_calc_rho function, so knowing rho beforehand is not necessary. 26 | } 27 | \details{ 28 | For Z=((x_mid - x_low) / (x_high - x_low)), 29 | Z can not be in (0.51,0.49) 30 | } 31 | \examples{ 32 | \dontrun{ SAVF_exp_score(70, 0, 90, 150, FALSE)} 33 | 34 | } 35 | -------------------------------------------------------------------------------- /tests/testthat/test_value_hierarchy_tree.R: -------------------------------------------------------------------------------- 1 | branches<- as.data.frame(matrix(ncol=5,nrow=7)) 2 | names(branches)<-c("Level1","Level2","Level3","Leaf","Weight") 3 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 4 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 5 | branches[3,]<-rbind("QB","Size","","Height","0.096") 6 | branches[4,]<-rbind("QB","Size","","Weight","0.224") 7 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 8 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 9 | branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 10 | 11 | 12 | test_that("value_hierarchy_tree provides proper messages and warnings",{ 13 | expect_error(value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3,leaves=c(1,2,3,4,5,6,7),weights=branches$Weight)) 14 | expect_error(value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3,leaves=c("Forty","Shuttle","Height","Weight","Wonderlic","Vertical",""),weights=branches$Weight)) 15 | }) 16 | 17 | 18 | -------------------------------------------------------------------------------- /man/SAVF_exp_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/SAVF_exp_plot.R 3 | \name{SAVF_exp_plot} 4 | \alias{SAVF_exp_plot} 5 | \title{Single Attribute Value Function (SAVF) Exponential Plot} 6 | \usage{ 7 | SAVF_exp_plot(x, x_low, x_mid, x_high, increasing = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{Attribute raw value} 11 | 12 | \item{x_low}{Lowest Value} 13 | 14 | \item{x_mid}{Midpoint value} 15 | 16 | \item{x_high}{Highest value} 17 | 18 | \item{increasing}{TRUE=increasing, FALSE=decreasing, Default: TRUE} 19 | } 20 | \value{ 21 | Exponential SAVF curve with attribute plotted 22 | } 23 | \description{ 24 | : Plots an increasing or decreasing exponential Single Attribute Value Function (SAVF) curve. 25 | It calls the SAVF_calc_rho and SAVF_exp_score functions and plots your score on the curve with a blue dot. 26 | } 27 | \details{ 28 | For Z=((x_mid - x_low) / (x_high - x_low)), 29 | Z can not be in (0.51,0.49) 30 | } 31 | \examples{ 32 | \dontrun{ SAVF_exp_plot(90, 0, 120, 150)} 33 | 34 | } 35 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(MAVF_Scores) 4 | export(MAVF_breakout) 5 | export(SAVF_calc_rho) 6 | export(SAVF_cat_plot) 7 | export(SAVF_categorical_score) 8 | export(SAVF_exp_plot) 9 | export(SAVF_exp_score) 10 | export(SAVF_linear_plot) 11 | export(SAVF_linear_score) 12 | export(sensitivity_plot) 13 | export(value_hierarchy_tree) 14 | import(Cairo) 15 | import(gridExtra) 16 | import(viridisLite) 17 | importFrom(data.tree,Do) 18 | importFrom(data.tree,SetNodeStyle) 19 | importFrom(data.tree,as.Node) 20 | importFrom(dplyr,"%>%") 21 | importFrom(dplyr,group_by) 22 | importFrom(dplyr,left_join) 23 | importFrom(dplyr,mutate) 24 | importFrom(dplyr,quo) 25 | importFrom(ggplot2,aes) 26 | importFrom(ggplot2,coord_flip) 27 | importFrom(ggplot2,geom_bar) 28 | importFrom(ggplot2,geom_line) 29 | importFrom(ggplot2,geom_point) 30 | importFrom(ggplot2,geom_vline) 31 | importFrom(ggplot2,ggplot) 32 | importFrom(ggplot2,ggtitle) 33 | importFrom(ggplot2,labs) 34 | importFrom(ggplot2,xlab) 35 | importFrom(ggplot2,ylab) 36 | importFrom(graphics,plot) 37 | importFrom(stats,reorder) 38 | importFrom(stats,runif) 39 | importFrom(stats,uniroot) 40 | importFrom(tidyr,gather) 41 | -------------------------------------------------------------------------------- /R/SAVF_categorical_plot.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Categorical Plot 2 | #' 3 | #'@description: Plots the categorical Single Attribute Value Function (SAVF) graph. Categories may be any value, but category scores must be numeric. 4 | #'The function checks to ensure the total of scores sums to one. 5 | #' 6 | #'@param categories Vector of categories 7 | #'@param scores Numeric vector of catgory scores 8 | #'@param fillcolor Fill color for the chart, default is blue 9 | #' 10 | #'@return Categorical SAVF graph 11 | #' 12 | #'@importFrom ggplot2 ggplot geom_bar xlab ylab aes 13 | #'@importFrom stats reorder 14 | #' 15 | #'@examples 16 | #'\dontrun{ SAVF_cat_plot(c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65))} 17 | #' 18 | #'@export 19 | 20 | SAVF_cat_plot <- function(categories, scores, fillcolor = "blue") { 21 | 22 | x = categories 23 | v = scores 24 | if (sum(v) != 1) { 25 | stop("Sum of scores must equal 1", call. = FALSE) 26 | } 27 | 28 | df <- data.frame(x = x, v = v) 29 | ggplot2::ggplot(df, ggplot2::aes(x = stats::reorder(categories, scores), v)) + 30 | ggplot2::geom_bar(stat = "identity", fill = fillcolor) + 31 | ggplot2::xlab("Category") + ggplot2::ylab("SAVF Score") 32 | } 33 | -------------------------------------------------------------------------------- /R/SAVF_categorical_score.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Categorical Score 2 | #' 3 | #'@description: Calculates the Single Attribute Value Function (SAVF) score for a categorical value. 4 | #' 5 | #'@param x Attribute raw value 6 | #'@param categories Vector of categories 7 | #'@param weights Numeric vector of category weights 8 | #' 9 | #'@return Categorical SAVF Score 10 | #' 11 | #'@importFrom dplyr left_join mutate 12 | #' 13 | #'@examples 14 | #'\dontrun{ SAVF_categorical_score("Tom", c("Tom", "Bill" ,"Jerry"), c(0.1, 0.25, 0.65))} 15 | #' 16 | #'@export 17 | 18 | SAVF_categorical_score <- function(x, categories, weights){ 19 | 20 | if(is.element(x, categories)==FALSE) { 21 | stop('Attribute raw value or vector of values, x, is not in the vector of categories') 22 | } 23 | 24 | if(sum(weights) < 1) { 25 | warning('Sum of weights is less than 1') 26 | } 27 | 28 | if(sum(weights) > 1) { 29 | warning('Sum of weights is greater than 1') 30 | } 31 | 32 | x <- data.frame(x) 33 | names(x) <- c("categories") 34 | df <- data.frame(categories, weights) 35 | combined <- sort(union(levels(x$categories), levels(df$categories))) 36 | value <- dplyr::left_join(dplyr::mutate(x, categories=factor(categories, levels=combined)), 37 | dplyr::mutate(df, categories=factor(categories, levels=combined)),by="categories") 38 | return(value[,2]) 39 | } 40 | -------------------------------------------------------------------------------- /R/SAVF_linear_score.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Linear Score 2 | #' 3 | #'@description: Calculates the Single Attribute Value Function (SAVF) score for a linearly increasing or decreasing function. 4 | #'It calculates the score based on the midpoint value method. 5 | #' 6 | #'@param x Attribute raw value 7 | #'@param x_low Lowest value 8 | #'@param x_mid Midpoint value 9 | #'@param x_high Highest value 10 | #'@param increasing TRUE=increasing, FALSE=decreasing, Default: TRUE 11 | #' 12 | #'@return Linear SAVF Score 13 | #' 14 | #'@examples 15 | #'\dontrun{ SAVF_linear_score(10, 0, 25, 100, FALSE)} 16 | #' 17 | #'@export 18 | 19 | SAVF_linear_score <- function(x, x_low, x_mid, x_high, increasing = TRUE) { 20 | 21 | if(x_low >x_high | x_low>x_mid) { 22 | stop('The input for x_low exceeds either x_mid or x_high') 23 | } 24 | if(x_high 20 | BugReports: https://github.com/AFIT-R/DecisionAnalysis 21 | Date: 2018-03-30 22 | Description: Aides in the multi objective decision analysis process by simplifying the creation of value hierarchy tree plots, 23 | calculating and plotting single and multi attribute value function scores, and conducting sensitivity analysis. Linear, exponential, 24 | and categorical single attribute value functions are supported. 25 | License: GPL (>= 2) 26 | Encoding: UTF-8 27 | LazyData: true 28 | Depends: 29 | R (>= 2.10) 30 | Imports: stats, 31 | ggplot2, 32 | tidyr, 33 | dplyr, 34 | graphics, 35 | data.tree, 36 | gridExtra, 37 | viridisLite, 38 | Cairo 39 | RoxygenNote: 6.0.1 40 | Suggests: 41 | knitr, 42 | rmarkdown, 43 | testthat 44 | VignetteBuilder: knitr 45 | -------------------------------------------------------------------------------- /man/MAVF_breakout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/MAVF_breakout.R 3 | \name{MAVF_breakout} 4 | \alias{MAVF_breakout} 5 | \title{Multiple Attribute Value Function (MAVF) Breakout} 6 | \usage{ 7 | MAVF_breakout(SAVF_matrix, weights, names) 8 | } 9 | \arguments{ 10 | \item{SAVF_matrix}{Matrix of SAVF scores} 11 | 12 | \item{weights}{Numeric vector of SAVF weights} 13 | 14 | \item{names}{Vector of attribute names} 15 | } 16 | \value{ 17 | MAVF breakout graph 18 | } 19 | \description{ 20 | : Takes a matrix of Single Attribute Value Function (SAVF) scores and shows the break out of each alternative's weighted SAVF scores. 21 | The sum of the alternative's weighted SAVF scores is their MAVF score. 22 | } 23 | \examples{ 24 | \dontrun{ 25 | 26 | qbdata <- NFLcombine[1:7,] 27 | 28 | Height <- SAVF_exp_score(qbdata$heightinchestotal, 68, 75.21, 82) 29 | Weight <- SAVF_exp_score(qbdata$weight, 185, 224.34, 275) 30 | Forty <- SAVF_exp_score(qbdata$fortyyd, 4.3, 4.81, 5.4, increasing=FALSE) 31 | Shuttle <- SAVF_exp_score(qbdata$twentyss, 3.8, 4.3, 4.9, increasing=FALSE) 32 | Vertical <- SAVF_exp_score(qbdata$vertical, 21, 32.04, 40) 33 | Broad <- SAVF_exp_score(qbdata$broad, 90, 111.24, 130) 34 | Wonderlic <- SAVF_exp_score(qbdata$wonderlic, 0, 27.08, 50) 35 | 36 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 37 | Vertical, Broad, Wonderlic) 38 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 39 | 40 | MAVF_breakout(SAVF_matrix, weights, qbdata$name)} 41 | 42 | } 43 | -------------------------------------------------------------------------------- /tests/testthat/test_MAVF_breakout.R: -------------------------------------------------------------------------------- 1 | SAVF_matrix <- as.data.frame(matrix(ncol=7,nrow=8)) 2 | names(SAVF_matrix)<-c("Height","Weight","Forty","Shuttle","Vertical","Broad","Wonderlic") 3 | SAVF_matrix[1,]<-rbind(0.414,0.45,0.473,0.366,0.553,0.395,0.839) 4 | SAVF_matrix[2,]<-rbind(0.557,0.607,0.688,0.537,0.582,0.726,0.817) 5 | SAVF_matrix[3,]<-rbind(0.414,0.552,0.669,0.7,0.611,0.621,0.664) 6 | SAVF_matrix[4,]<-rbind(0.557,0.485,0.446,0.383,0.525,0.469,0.56) 7 | SAVF_matrix[5,]<-rbind(0.414,0.391,0.482,0.528,0.367,0.37,0.539) 8 | SAVF_matrix[6,]<-rbind(0.775,0.8,0.128,0,0.117,0,0.478) 9 | SAVF_matrix[7,]<-rbind(0.629,0.751,0.737,0.613,0.67,0.888,0.38) 10 | SAVF_matrix[8,]<-rbind(0.485,0.574,0.786,0.671,0.67,0.596,0.36) 11 | 12 | weights2 <- as.data.frame(matrix(ncol=7,nrow=1)) 13 | weights2[1,]<-rbind(0.414,0.45,0.473,0.366,0.553,0.395,0.839) 14 | 15 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 16 | names = c("Greg McElroy","Blaine Gabbert","Christian Ponder","Ricky Stanzi","Andy Dalton","Ryan Mallett","Cam Newton","Jack Locker") 17 | 18 | test_that("MAVF_breakout provides proper messages and warnings",{ 19 | expect_error(MAVF_breakout(SAVF_matrix, weights, names)) 20 | SAVF_matrix<-as.matrix(SAVF_matrix) 21 | expect_error(MAVF_breakout(SAVF_matrix,weights2,names)) 22 | expect_error(MAVF_breakout(SAVF_matrix,weights=SAVF_matrix,names)) 23 | expect_error(MAVF_breakout(SAVF_matrix[,1:6], weights, names)) 24 | expect_error(MAVF_breakout(SAVF_matrix, weights, c("Greg McElroy","Blaine Gabbert","Christian Ponder"))) 25 | expect_warning(MAVF_breakout(SAVF_matrix, c(0.096, 0.224, 0.092, 0.138, 0.150, 0.220, 0.05), names)) 26 | expect_warning(MAVF_breakout(SAVF_matrix, c(0.096, 0.224, 0.092, 0.155, 0.175, 0.228, 0.15), names)) 27 | }) -------------------------------------------------------------------------------- /R/SAVF_exp_score.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Exponential Score 2 | #' 3 | #'@description: Calculates the Single Attribute Values Function (SAVF) score for an exponentially increasing or decreasing function. 4 | #'It calls the SAVF_calc_rho function, so knowing rho beforehand is not necessary. 5 | #' 6 | #'@param x Attribute raw value 7 | #'@param x_low Lowest value 8 | #'@param x_mid Midpoint value 9 | #'@param x_high Highest value 10 | #'@param increasing TRUE=increasing, FALSE=decreasing, Default: TRUE 11 | #' 12 | #'@details 13 | #'For Z=((x_mid - x_low) / (x_high - x_low)), 14 | #'Z can not be in (0.51,0.49) 15 | #' 16 | #'@return Exponential SAVF Score 17 | #' 18 | #'@examples 19 | #'\dontrun{ SAVF_exp_score(70, 0, 90, 150, FALSE)} 20 | #' 21 | #'@export 22 | 23 | SAVF_exp_score <- function(x, x_low, x_mid, x_high, increasing = TRUE) { 24 | 25 | if(x_low >x_high | x_low>x_mid) { 26 | stop('The input for x_low exceeds either x_mid or x_high') 27 | } 28 | if(x_high 2 | [![Build Status](https://travis-ci.org/AFIT-R/DecisionAnalysis.svg?branch=master)](https://travis-ci.org/AFIT-R/DecisionAnalysis) [![Coverage Status](https://codecov.io/github/AFIT-R/DecisionAnalysis/coverage.svg?branch=master)](https://codecov.io/github/AFIT-R/DecisionAnalysis?branch=master) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/DecisionAnalysis)](https://cran.r-project.org/package=DecisionAnalysis) [![Downloads](http://cranlogs.r-pkg.org/badges/DecisionAnalysis)](http://cranlogs.r-pkg.org/badges/DecisionAnalysis) [![Total Downloads](http://cranlogs.r-pkg.org/badges/grand-total/DecisionAnalysis)](http://cranlogs.r-pkg.org/badges/grand-total/DecisionAnalysis) 3 | 4 | DecisionAnalysis 5 | ---------------- 6 | 7 | Multi-Objective Decision Analysis 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. 8 | 9 | Using DecisionAnalysis allows individuals to consider and weight factors and trade-offs while evaluating each alternative. The individuals are then able to discuss the results and trade offs to help decide on a recommendation. 10 | 11 | The DecisionAnalysis package contains all of the necessary functions required to : 12 | 13 | 1. Plot a value hierarchy tree with weights 14 | 2. Calculate and plot linear, exponential, and categorical single attribute value functions 15 | 3. Calculate multiple attribute value function scores and plot their breakout 16 | 4. Conduct sensitivity analysis 17 | 18 | Installation 19 | ------------ 20 | 21 | The `DecisionAnalysis` package is now availible on CRAN, but can also be installed using the [devtools](https://cran.r-project.org/web/packages/devtools/index.html) package: 22 | 23 | if (!requireNamespace("devtools")) install.packages("devtools") 24 | devtools::install_github("AFIT-R/DecisionAnalysis") 25 | -------------------------------------------------------------------------------- /man/sensitivity_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sensitivity_plot.R 3 | \name{sensitivity_plot} 4 | \alias{sensitivity_plot} 5 | \title{Sensitivity Analysis Graph} 6 | \usage{ 7 | sensitivity_plot(SAVF_matrix, weights, names, criteria, title = TRUE) 8 | } 9 | \arguments{ 10 | \item{SAVF_matrix}{Matrix of SAVF scores} 11 | 12 | \item{weights}{Numeric vector of SAVF weights} 13 | 14 | \item{names}{The names of the alternatives} 15 | 16 | \item{criteria}{Numeric value equal to the column number of the SAVF_matrix that contains the desired criteria to conduct sensitivity analysis on} 17 | 18 | \item{title}{True=The title is the column name associated with the selected criteria, False=no title, Default: TRUE} 19 | } 20 | \value{ 21 | Sensitivity Analysis graph 22 | } 23 | \description{ 24 | Takes a matrix of Single Attribute Value Function (SAVF) scores and shows how each alternative's 25 | MAVF scores change as the weight for that criteria changes from zero to one. The vertical black line represents the current weight. 26 | } 27 | \examples{ 28 | \dontrun{ 29 | 30 | library(dplyr) 31 | 32 | qbdata <- NFLcombine \%>\% 33 | filter(year == '2011', position == 'QB', wonderlic != '0') \%>\% 34 | select(c(2, 8, 9, 12, 15, 17, 18, 25, 20)) 35 | qbdata[qbdata == 0] = NA 36 | 37 | Height <- SAVF_exp_score(qbdata$heightinchestotal, 68, 75.21, 82) 38 | Weight <- SAVF_exp_score(qbdata$weight, 185, 224.34, 275) 39 | Forty <- SAVF_exp_score(qbdata$fortyyd, 4.3, 4.81, 5.4, increasing=FALSE) 40 | Shuttle <- SAVF_exp_score(qbdata$twentyss, 3.8, 4.3, 4.9, increasing=FALSE) 41 | Vertical <- SAVF_exp_score(qbdata$vertical, 21, 32.04, 40) 42 | Broad <- SAVF_exp_score(qbdata$broad, 90, 111.24, 130) 43 | Wonderlic <- SAVF_exp_score(qbdata$wonderlic, 0, 27.08, 50) 44 | 45 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, Vertical, Broad, Wonderlic) 46 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 47 | 48 | sensitivity_plot(SAVF_matrix, weights, qbdata$name, 4) 49 | } 50 | 51 | } 52 | -------------------------------------------------------------------------------- /R/data.R: -------------------------------------------------------------------------------- 1 | #' NFL Scouting Combine data 2 | #' 3 | #' A dataset containing the biographical data and scores for 4947 NFL draft candidates that attended the NFL Scouting Combine from 1999 to 2015. 4 | #' 5 | #' @format A data frame with 4947 rows and 26 variables: 6 | #' \describe{ 7 | #' \item{year}{Year that the NFL draft candidate attended the NFL combine event} 8 | #' \item{name}{First and last name of the NFL draft candidate} 9 | #' \item{firstname}{First name of the NFL draft candidate} 10 | #' \item{lastname}{Last name of the NFL draft candidate} 11 | #' \item{position}{Position of the NFL draft candidate} 12 | #' \item{heightfeet}{Candidate's height, only the feet portion} 13 | #' \item{heightinches}{Candidate's height, only the inches portion} 14 | #' \item{heightinchestotal}{Candidate's total height in inches} 15 | #' \item{weight}{Total weight in lbs} 16 | #' \item{arms}{Candidate's arm length in inches} 17 | #' \item{hands}{Candidate's hand size in inches} 18 | #' \item{fortyyd}{Time in seconds to run forty yards} 19 | #' \item{twentyyd}{Time in seconds to run twenty yards} 20 | #' \item{tenyd}{Time in seconds to run ten yards} 21 | #' \item{twentyss}{Time in seconds to complete the twenty yard shuttle sprint} 22 | #' \item{threecone}{Time in seconds to complete the three cone drill} 23 | #' \item{vertical}{Height candidate jumped vertically in inches} 24 | #' \item{broad}{Distance traveled during broad jump in inches} 25 | #' \item{bench}{Number of repetitions a candidate bench pressed 225lbs} 26 | #' \item{round}{The round the candidate was selected in the draft} 27 | #' \item{college}{College the candidate attended} 28 | #' \item{pick}{The candidate's pick number in the round that they got drafted, followed by the candidate's overall pick number for that year's NFL draft} 29 | #' \item{pickround}{The candidate's pick number in the round that they got drafted} 30 | #' \item{picktotal}{The candidate's overall pick number for that year's NFL draft} 31 | #' \item{wonderlic}{Raw score received on the Wonderlic test} 32 | #' \item{nflgrade}{The grade the candidate is given on NFL.com} 33 | #' } 34 | #' @source \url{http://www.nflsavant.com/about.php} 35 | "NFLcombine" 36 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | 2 | --- 3 | output: 4 | md_document: 5 | variant: markdown_github 6 | --- 7 | 8 | 9 | 10 | ```{r, echo = FALSE} 11 | knitr::opts_chunk$set( 12 | collapse = TRUE, 13 | comment = "#>", 14 | fig.path = "README-" 15 | ) 16 | ``` 17 | 18 | [![Build Status](https://travis-ci.org/AFIT-R/DecisionAnalysis.svg?branch=master)](https://travis-ci.org/AFIT-R/DecisionAnalysis) 19 | [![Coverage Status](https://codecov.io/github/AFIT-R/DecisionAnalysis/coverage.svg?branch=master)](https://codecov.io/github/AFIT-R/DecisionAnalysis?branch=master) 20 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/DecisionAnalysis)](https://cran.r-project.org/package=DecisionAnalysis) 21 | [![Downloads](http://cranlogs.r-pkg.org/badges/DecisionAnalysis)](http://cranlogs.r-pkg.org/badges/DecisionAnalysis) 22 | [![Total Downloads](http://cranlogs.r-pkg.org/badges/grand-total/DecisionAnalysis)](http://cranlogs.r-pkg.org/badges/grand-total/DecisionAnalysis) 23 | 24 | ##DecisionAnalysis 25 | 26 | Multi-Objective Decision Analysis 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. 27 | 28 | Using DecisionAnalysis allows individuals to consider and weight factors and trade-offs while evaluating each alternative. The individuals are then able to discuss the results and trade offs to help decide on a recommendation. 29 | 30 | The DecisionAnalysis package contains all of the necessary functions required to : 31 | 32 | 1. Plot a value hierarchy tree with weights 33 | 2. Calculate and plot linear, exponential, and categorical single attribute value functions 34 | 3. Calculate multiple attribute value function scores and plot their breakout 35 | 4. Conduct sensitivity analysis 36 | 37 | ## Installation 38 | 39 | The `DecisionAnalysis` package is currently in development and only available from GitHub, but can easily be installed using the [devtools](https://cran.r-project.org/web/packages/devtools/index.html) package: 40 | 41 | ``` 42 | if (!requireNamespace("devtools")) install.packages("devtools") 43 | devtools::install_github("AFIT-R/DecisionAnalysis") 44 | ``` 45 | 46 | -------------------------------------------------------------------------------- /man/NFLcombine.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/data.R 3 | \docType{data} 4 | \name{NFLcombine} 5 | \alias{NFLcombine} 6 | \title{NFL Scouting Combine data} 7 | \format{A data frame with 4947 rows and 26 variables: 8 | \describe{ 9 | \item{year}{Year that the NFL draft candidate attended the NFL combine event} 10 | \item{name}{First and last name of the NFL draft candidate} 11 | \item{firstname}{First name of the NFL draft candidate} 12 | \item{lastname}{Last name of the NFL draft candidate} 13 | \item{position}{Position of the NFL draft candidate} 14 | \item{heightfeet}{Candidate's height, only the feet portion} 15 | \item{heightinches}{Candidate's height, only the inches portion} 16 | \item{heightinchestotal}{Candidate's total height in inches} 17 | \item{weight}{Total weight in lbs} 18 | \item{arms}{Candidate's arm length in inches} 19 | \item{hands}{Candidate's hand size in inches} 20 | \item{fortyyd}{Time in seconds to run forty yards} 21 | \item{twentyyd}{Time in seconds to run twenty yards} 22 | \item{tenyd}{Time in seconds to run ten yards} 23 | \item{twentyss}{Time in seconds to complete the twenty yard shuttle sprint} 24 | \item{threecone}{Time in seconds to complete the three cone drill} 25 | \item{vertical}{Height candidate jumped vertically in inches} 26 | \item{broad}{Distance traveled during broad jump in inches} 27 | \item{bench}{Number of repetitions a candidate bench pressed 225lbs} 28 | \item{round}{The round the candidate was selected in the draft} 29 | \item{college}{College the candidate attended} 30 | \item{pick}{The candidate's pick number in the round that they got drafted, followed by the candidate's overall pick number for that year's NFL draft} 31 | \item{pickround}{The candidate's pick number in the round that they got drafted} 32 | \item{picktotal}{The candidate's overall pick number for that year's NFL draft} 33 | \item{wonderlic}{Raw score received on the Wonderlic test} 34 | \item{nflgrade}{The grade the candidate is given on NFL.com} 35 | }} 36 | \source{ 37 | \url{http://www.nflsavant.com/about.php} 38 | } 39 | \usage{ 40 | NFLcombine 41 | } 42 | \description{ 43 | A dataset containing the biographical data and scores for 4947 NFL draft candidates that attended the NFL Scouting Combine from 1999 to 2015. 44 | } 45 | \keyword{datasets} 46 | -------------------------------------------------------------------------------- /R/SAVF_calc_rho.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Calculate Rho 2 | #' 3 | #'@description: Calculates rho for an exponential function. 4 | #' 5 | #'@param x_low Lowest value 6 | #'@param x_mid Midpoint value 7 | #'@param x_high Highest value 8 | #'@param increasing TRUE=increasing, FALSE=decreasing, Default: TRUE 9 | #' 10 | #'@details 11 | #'For Z=((x_mid - x_low) / (x_high - x_low)), 12 | #'Z can not be in (0.51,0.49) 13 | #' 14 | #'@return Rho 15 | #' 16 | #'@importFrom stats uniroot 17 | #' 18 | #'@examples 19 | #'\dontrun{ SAVF_calc_rho(0, 90, 150, FALSE)} 20 | #' 21 | #'@export 22 | 23 | 24 | SAVF_calc_rho <- function(x_low, x_mid, x_high, increasing = TRUE){ 25 | 26 | if(x_low >x_high | x_low>x_mid) { 27 | stop('The input for x_low exceeds either x_mid or x_high') 28 | } 29 | if(x_highx_high | x_low>x_mid) { 25 | stop('The input for x_low exceeds either x_mid or x_high') 26 | } 27 | if(x_high 1) { 54 | warning('The sum of weights is greater than 1') 55 | } 56 | 57 | if(ncol(SAVF_matrix) != length(weights)) { 58 | stop('The number of columns in the SAVF matrix must equal the length of the vector of weights') 59 | } 60 | 61 | if(nrow(SAVF_matrix) != length(names) ) { 62 | stop('The number of rows in the SAVF matrix must equal the length of the vector of names') 63 | } 64 | } 65 | 66 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 67 | 68 | 69 | MAVF = SAVF_matrix %*% weights 70 | value <- data.frame(names, MAVF) 71 | names(value) <- c("Name", "Score") 72 | value <- value[order(value$Score, decreasing = TRUE),] 73 | return(value) 74 | } 75 | -------------------------------------------------------------------------------- /R/DecisionAnalysis_package.R: -------------------------------------------------------------------------------- 1 | #' DecisionAnalysis: Multi-Objective Decision Analysis 2 | #' 3 | #' The DecisionAnalysis package contains all of the necessary functions required to plot weighted and unweighted value hierarchy trees, calculate and plot linear, exponential, and categorical single attribute value functions, 4 | #' calculate and graph multi value attribute functions, and conduct sensitivity analysis. 5 | #' 6 | #' Start with the vignette to learn more about using the DecisionAnalysis package: 7 | #' browseVignettes(package = "DecisionAnalysis") 8 | #' 9 | #' @examples 10 | #' 11 | #'#Create a value hierarchy tree 12 | #'branches<- as.data.frame(matrix(ncol=5,nrow=7)) 13 | #'names(branches)<-c("Level1","Level2","Level3","leaves","weights") 14 | #'branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 15 | #'branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 16 | #'branches[3,]<-rbind("QB","Size","","Height","0.096") 17 | #'branches[4,]<-rbind("QB","Size","","Weight","0.224") 18 | #'branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 19 | #'branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 20 | #'branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 21 | #'value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 22 | #'leaves=branches$leaves,weights=branches$weights) 23 | #' 24 | #' 25 | #'#subset NFLcombine data from DecisionAnalysis package 26 | #'qbdata <- NFLcombine[1:7,] 27 | #' 28 | #'#Create SAVF_matrix 29 | #'Height <- SAVF_exp_score(qbdata$heightinchestotal, 68, 75.21, 82) 30 | #'Weight <- SAVF_exp_score(qbdata$weight, 185, 224.34, 275) 31 | #'Forty <- SAVF_exp_score(qbdata$fortyyd, 4.3, 4.81, 5.4, increasing=FALSE) 32 | #'Shuttle <- SAVF_exp_score(qbdata$twentyss, 3.8, 4.3, 4.9, increasing=FALSE) 33 | #'Vertical <- SAVF_exp_score(qbdata$vertical, 21, 32.04, 40) 34 | #'Broad <- SAVF_exp_score(qbdata$broad, 90, 111.24, 130) 35 | #'Wonderlic <- SAVF_exp_score(qbdata$wonderlic, 0, 27.08, 50) 36 | #'SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, Vertical, Broad, Wonderlic) 37 | #' 38 | #'#Create weights vector 39 | #'weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 40 | #' 41 | #'#Calculate MAVF Score 42 | #'MAVF_Scores(SAVF_matrix, weights, qbdata$name) 43 | #' 44 | #'#Plot MAVF Breakout 45 | #'MAVF_breakout(SAVF_matrix, weights, qbdata$name) 46 | #' 47 | #'#Plot sensitivity analysis for shuttle criteria 48 | #'sensitivity_plot(SAVF_matrix, weights, qbdata$name, 4) 49 | #' 50 | #'@seealso 51 | #' 52 | #'Report bugs at https://github.com/AFIT-R/DecisionAnalysis 53 | #' 54 | "_PACKAGE" 55 | #> [1] "_PACKAGE" 56 | 57 | #' @import Cairo 58 | #' @import viridisLite 59 | #' @import gridExtra 60 | NULL -------------------------------------------------------------------------------- /R/SAVF_exp_plot.R: -------------------------------------------------------------------------------- 1 | #'@title Single Attribute Value Function (SAVF) Exponential Plot 2 | #' 3 | #'@description: Plots an increasing or decreasing exponential Single Attribute Value Function (SAVF) curve. 4 | #'It calls the SAVF_calc_rho and SAVF_exp_score functions and plots your score on the curve with a blue dot. 5 | #' 6 | #'@param x Attribute raw value 7 | #'@param x_low Lowest Value 8 | #'@param x_mid Midpoint value 9 | #'@param x_high Highest value 10 | #'@param increasing TRUE=increasing, FALSE=decreasing, Default: TRUE 11 | #' 12 | #'@details 13 | #'For Z=((x_mid - x_low) / (x_high - x_low)), 14 | #'Z can not be in (0.51,0.49) 15 | #' 16 | #'@return Exponential SAVF curve with attribute plotted 17 | #' 18 | #'@importFrom ggplot2 ggplot geom_line xlab ylab geom_point aes 19 | #' 20 | #'@examples 21 | #'\dontrun{ SAVF_exp_plot(90, 0, 120, 150)} 22 | #' 23 | #'@export 24 | 25 | SAVF_exp_plot <- function(x, x_low, x_mid, x_high, increasing = TRUE) { 26 | 27 | if(x_low >x_high | x_low>x_mid) { 28 | stop('The input for x_low exceeds either x_mid or x_high') 29 | } 30 | if(x_high% group_by quo 14 | #'@importFrom stats reorder 15 | #'@importFrom tidyr gather 16 | #' 17 | #'@examples 18 | #'\dontrun{ 19 | #' 20 | #'qbdata <- NFLcombine[1:7,] 21 | #' 22 | #'Height <- SAVF_exp_score(qbdata$heightinchestotal, 68, 75.21, 82) 23 | #'Weight <- SAVF_exp_score(qbdata$weight, 185, 224.34, 275) 24 | #'Forty <- SAVF_exp_score(qbdata$fortyyd, 4.3, 4.81, 5.4, increasing=FALSE) 25 | #'Shuttle <- SAVF_exp_score(qbdata$twentyss, 3.8, 4.3, 4.9, increasing=FALSE) 26 | #'Vertical <- SAVF_exp_score(qbdata$vertical, 21, 32.04, 40) 27 | #'Broad <- SAVF_exp_score(qbdata$broad, 90, 111.24, 130) 28 | #'Wonderlic <- SAVF_exp_score(qbdata$wonderlic, 0, 27.08, 50) 29 | #' 30 | #'SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 31 | #' Vertical, Broad, Wonderlic) 32 | #'weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 33 | #' 34 | #'MAVF_breakout(SAVF_matrix, weights, qbdata$name)} 35 | #' 36 | #'@export 37 | 38 | MAVF_breakout <- function(SAVF_matrix, weights, names){ 39 | 40 | if(class(SAVF_matrix) != "matrix") { 41 | stop('SAVF_matrix must be a matrix\n', 42 | 'You have provided an object of the following class:\n', 43 | 'SAVF_matrix: ', class(SAVF_matrix), '\n') 44 | } 45 | 46 | if(class(weights) != "numeric") { 47 | stop('weights must be of class numeric\n', 48 | 'You have provided an object of the following class:\n', 49 | 'weights: ', class(weights)) 50 | } 51 | if(sum(weights)< 1) { 52 | warning('The sum of weights is less than 1') 53 | } 54 | 55 | if(sum(weights)> 1) { 56 | warning('The sum of weights is greater than 1') 57 | } 58 | 59 | if(ncol(SAVF_matrix) != length(weights)) { 60 | stop('The number of columns in the SAVF matrix must equal the length of the vector of weights') 61 | } 62 | 63 | if(nrow(SAVF_matrix) != length(names) ) { 64 | stop('The number of rows in the SAVF matrix must equal the length of the vector of names') 65 | } 66 | 67 | Measurement <- dplyr::quo(Measurement) 68 | Value <- dplyr::quo(Value) 69 | 70 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 71 | SAVF <- t(SAVF_matrix) * weights 72 | MAVF = SAVF_matrix %*% weights 73 | value <- data.frame(names, MAVF, t(SAVF)) 74 | 75 | `%>%` <- dplyr::`%>%` 76 | 77 | 78 | value %>% 79 | tidyr::gather(Measurement, Value, -c(1:2)) %>% 80 | dplyr::group_by(Measurement) %>% 81 | ggplot2::ggplot(ggplot2::aes(x = stats::reorder(names, MAVF), y = Value, fill = Measurement)) + 82 | ggplot2::geom_bar(stat = "identity") + 83 | ggplot2::coord_flip() + 84 | ggplot2::ylab("Weighted SAVF Scores") + ggplot2::xlab("Alternatives") + 85 | ggplot2::ggtitle("Breakout of Weighted SAVF") 86 | } 87 | 88 | -------------------------------------------------------------------------------- /R/sensitivity_plot.R: -------------------------------------------------------------------------------- 1 | #'@title Sensitivity Analysis Graph 2 | #' 3 | #'@description Takes a matrix of Single Attribute Value Function (SAVF) scores and shows how each alternative's 4 | #'MAVF scores change as the weight for that criteria changes from zero to one. The vertical black line represents the current weight. 5 | #' 6 | #'@param SAVF_matrix Matrix of SAVF scores 7 | #'@param weights Numeric vector of SAVF weights 8 | #'@param names The names of the alternatives 9 | #'@param criteria Numeric value equal to the column number of the SAVF_matrix that contains the desired criteria to conduct sensitivity analysis on 10 | #'@param title True=The title is the column name associated with the selected criteria, False=no title, Default: TRUE 11 | #' 12 | #' 13 | #'@return Sensitivity Analysis graph 14 | #' 15 | #'@importFrom ggplot2 ggplot geom_line ylab xlab geom_vline aes labs 16 | #'@importFrom dplyr %>% quo 17 | #'@importFrom tidyr gather 18 | #' 19 | #'@examples 20 | #'\dontrun{ 21 | #' 22 | #'library(dplyr) 23 | #' 24 | #'qbdata <- NFLcombine %>% 25 | #' filter(year == '2011', position == 'QB', wonderlic != '0') %>% 26 | #' select(c(2, 8, 9, 12, 15, 17, 18, 25, 20)) 27 | #'qbdata[qbdata == 0] = NA 28 | #' 29 | #'Height <- SAVF_exp_score(qbdata$heightinchestotal, 68, 75.21, 82) 30 | #'Weight <- SAVF_exp_score(qbdata$weight, 185, 224.34, 275) 31 | #'Forty <- SAVF_exp_score(qbdata$fortyyd, 4.3, 4.81, 5.4, increasing=FALSE) 32 | #'Shuttle <- SAVF_exp_score(qbdata$twentyss, 3.8, 4.3, 4.9, increasing=FALSE) 33 | #'Vertical <- SAVF_exp_score(qbdata$vertical, 21, 32.04, 40) 34 | #'Broad <- SAVF_exp_score(qbdata$broad, 90, 111.24, 130) 35 | #'Wonderlic <- SAVF_exp_score(qbdata$wonderlic, 0, 27.08, 50) 36 | #' 37 | #'SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, Vertical, Broad, Wonderlic) 38 | #'weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 39 | #' 40 | #'sensitivity_plot(SAVF_matrix, weights, qbdata$name, 4) 41 | #'} 42 | #' 43 | #'@export 44 | 45 | sensitivity_plot <- function(SAVF_matrix, weights, names, criteria, title=TRUE){ 46 | 47 | #initialize variables used later on 48 | Names <- dplyr::quo(Names) 49 | Weight <- dplyr::quo(Weight) 50 | Value <- dplyr::quo(Value) 51 | 52 | if(class(SAVF_matrix) != "matrix") { 53 | stop('SAVF_matrix must be a matrix\n', 54 | 'You have provided an object of the following class:\n', 55 | 'SAVF_matrix: ', class(SAVF_matrix), '\n') 56 | } 57 | 58 | if(class(weights) != "numeric") { 59 | stop('weights must be of class numeric\n', 60 | 'You have provided an object of the following class:\n', 61 | 'weights: ', class(weights)) 62 | } 63 | 64 | if(sum(weights)< 1) { 65 | warning('The sum of weights is less than 1') 66 | } 67 | 68 | if(sum(weights)> 1) { 69 | warning('The sum of weights is greater than 1') 70 | } 71 | 72 | if(ncol(SAVF_matrix) != length(weights)) { 73 | stop('The number of columns in the SAVF matrix must equal the length of the vector of weights') 74 | } 75 | 76 | if(nrow(SAVF_matrix) != length(names) ) { 77 | stop('The number of rows in the SAVF matrix must equal the length of the vector of names') 78 | } 79 | 80 | if((class(criteria) != "numeric") | (criteria > nrow(SAVF_matrix)) ) { 81 | stop('criteria must be a column number of the SAVF_Matrix') 82 | } 83 | 84 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 85 | i <- criteria 86 | x <- seq(0, 1, by = .1) 87 | m <- matrix(NA, nrow = length(weights), ncol = 11) 88 | 89 | 90 | m<-sapply(1:length(weights), function(j) m[j,]<-(1 - x)*(weights[j] / (1 - weights[i]))) 91 | m<-t(m) 92 | m[i,] <- x 93 | M <- data.frame(MAVF_Scores(SAVF_matrix, m, names)) 94 | names(M) <- c("Names", x) 95 | 96 | `%>%` <- dplyr::`%>%` 97 | 98 | M %>% 99 | tidyr::gather(Weight, Value, -c(1)) %>% 100 | ggplot2::ggplot(ggplot2::aes(x = as.numeric(Weight), y = Value, 101 | group = Names, colour = Names)) + 102 | ggplot2::geom_line() + ggplot2::geom_vline(xintercept = weights[i]) + 103 | ggplot2::ylab("MAVF Score") + ggplot2::xlab("Weight") + 104 | if (title==TRUE){ 105 | ggplot2::labs(title= colnames(SAVF_matrix)[criteria]) 106 | } 107 | } 108 | -------------------------------------------------------------------------------- /R/value_hierarchy_tree.R: -------------------------------------------------------------------------------- 1 | #'@title Value Hierarchy Tree 2 | #' 3 | #'@description: Plots a value hierarchy tree 4 | #' 5 | #'@param ... One or more character vectors containing a single level of nodes. The character vector containing the end nodes should not be entered here. 6 | #'If there isn't a node for a level of the branch, it should be entered as "" 7 | #'@param leaves Character vector of values containing the last node of the branches 8 | #'@param weights Character or numeric vector of weights associated with the end node of the branches (Optional) 9 | #'@param nodestyle Style of the nodes, default is filled, rounded 10 | #'@param nodeshape Shape of the nodes, default is box 11 | #'@param nodefillcolor Fill color of the nodes, default is white 12 | #'@param nodefontname Font of the nodes, default is helvetica 13 | #'@param nodefontcolor Font color of the nodes, default is black 14 | #'@param leavesshape Shape of the leaves, default is egg 15 | #'@param leavesfillcolor Fill color of the leaves, default is gray 16 | #'@param leavesfontname Font of the leaves, default is helvetica 17 | #'@param leavesfontcolor Font color of the leaves, default is black 18 | #' 19 | #'@return Value hierarchy tree plot 20 | #' 21 | #'@importFrom data.tree as.Node SetNodeStyle Do 22 | #'@importFrom graphics plot 23 | #' 24 | #'@examples 25 | #'\dontrun{ branches<- as.data.frame(matrix(ncol=5,nrow=7)) 26 | #'names(branches)<-c("Level1","Level2","Level3","leaves","weights") 27 | #'branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 28 | #'branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 29 | #'branches[3,]<-rbind("QB","Size","","Height","0.096") 30 | #'branches[4,]<-rbind("QB","Size","","Weight","0.224") 31 | #'branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 32 | #'branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 33 | #'branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 34 | #' 35 | #'value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 36 | #'leaves=branches$leaves,weights=branches$weights) 37 | #'} 38 | #' 39 | #'@export 40 | 41 | 42 | value_hierarchy_tree <- function(...,leaves,weights, 43 | nodestyle="filled, rounded",nodeshape="box",nodefillcolor="white",nodefontname="helvetica",nodefontcolor="black", 44 | leavesshape="egg",leavesfillcolor="gray",leavesfontcolor="black", leavesfontname = "helvetica"){ 45 | 46 | #Check if leaves is character 47 | if(class(leaves) != "character") { 48 | stop( 49 | 'leaves must be a character vector\n', 50 | 'You have provided an object of the following class:\n', 51 | 'leaves: ', class(leaves), '\n') 52 | } 53 | 54 | #Check if any end nodes are not in the leaves vector 55 | if(!is.na(match("",leaves))) { 56 | stop('All end nodes must be in the leaves vector') 57 | } 58 | 59 | #initialize treebranches matrix for use in as.Node function 60 | treebranches <- matrix(NA, nrow = length(leaves), ncol = 1) 61 | treebranches <- as.data.frame(treebranches) 62 | colnames(treebranches) <- "pathString" 63 | 64 | #Check if weights input was provided. If provided, then combine weights and end nodes into one string 65 | if(missing(weights)) { 66 | leavesweights <- leaves 67 | } else { 68 | leavesweights <- paste0(leaves,"\n","(",weights,")") 69 | } 70 | 71 | #Transform inputs into format for as.Node function 72 | treebranches$pathString <- paste(...,leavesweights,sep="/") 73 | 74 | #Replace all instances of more than one slash (/) with just one slash (/) 75 | treebranches$pathString <- gsub("//{2,}", "//",treebranches$pathString) 76 | 77 | #Create value hierarchy tree 78 | finaltree<-data.tree::as.Node(treebranches) 79 | 80 | #set node style for plot 81 | data.tree::SetNodeStyle(finaltree, style = nodestyle, shape = nodeshape, 82 | fontcolor = nodefontcolor, 83 | fillcolor = nodefillcolor, 84 | fontname = nodefontname, tooltip=data.tree::GetDefaultTooltip) 85 | 86 | #set leaves style for plot 87 | data.tree::Do(finaltree$leaves, 88 | function(node) data.tree::SetNodeStyle(node, shape = leavesshape, 89 | fillcolor = leavesfillcolor, fontcolor = leavesfontcolor, fontname = leavesfontname)) 90 | #plot value hierarchy tree 91 | graphics::plot(finaltree) 92 | 93 | } 94 | 95 | -------------------------------------------------------------------------------- /inst/doc/MultiObjectiveDecisionAnalysisinR.R: -------------------------------------------------------------------------------- 1 | ## ----warning=FALSE, message=FALSE---------------------------------------- 2 | library(dplyr) 3 | library(gridExtra) 4 | library(knitr) 5 | 6 | ## ------------------------------------------------------------------------ 7 | qbdata <- MODA::NFLcombine %>% 8 | filter(year == '2011', position == 'QB', wonderlic != '0') %>% 9 | select(c(2, 8, 9, 12, 15, 17, 18, 25, 20)) 10 | qbdata[qbdata == 0] = NA 11 | names(qbdata) <- c("Name", "Height", "Weight", "Forty", 12 | "Shuttle", "Vertical", "Broad", "Wonderlic", "Round") 13 | 14 | ## ----echo=FALSE---------------------------------------------------------- 15 | knitr::kable(qbdata, caption = "Data") 16 | 17 | ## ----fig.cap="Value Hierarchy", fig.align='center', fig.width=7, fig.height=4---- 18 | branches<- as.data.frame(matrix(ncol=4,nrow=7)) 19 | names(branches)<-c("Level1","Level2","Level3","leaves") 20 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty") 21 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle") 22 | branches[3,]<-rbind("QB","Size","","Height") 23 | branches[4,]<-rbind("QB","Size","","Weight") 24 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic") 25 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical") 26 | branches[7,]<-rbind("QB","Strength","Power","Broad") 27 | 28 | MODA::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 29 | leaves=branches$leaves, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 30 | 31 | 32 | ## ----warning=FALSE, fig.asp=.75, fig.align='center',fig.width=6, fig.height=5---- 33 | a1 <- MODA::SAVF_exp_plot(90, 0, 120, 150) 34 | a2 <- MODA::SAVF_linear_plot(10, 0, 20, 100, FALSE) 35 | a3 <- MODA::SAVF_cat_plot(c("Tom", "Bill", "Jerry"), c(0.1, 0.25, 0.65)) 36 | gridExtra::grid.arrange(a1, a2, a3, ncol = 2) 37 | 38 | ## ------------------------------------------------------------------------ 39 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 40 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 41 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 42 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 43 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 44 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 45 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 46 | 47 | SAVF_matrix = cbind(qbdata$Name, Height, Weight, Forty, Shuttle, 48 | Vertical, Broad, Wonderlic) 49 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 50 | 51 | knitr::kable(SAVF_matrix, caption = "SAVF Scores") 52 | 53 | ## ---- fig.align='center', fig.cap="Weighted Value Hierarchy",fig.width=7, fig.height=4---- 54 | branches<- as.data.frame(matrix(ncol=5,nrow=7)) 55 | names(branches)<-c("Level1","Level2","Level3","leaves","weights") 56 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 57 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 58 | branches[3,]<-rbind("QB","Size","","Height","0.096") 59 | branches[4,]<-rbind("QB","Size","","Weight","0.224") 60 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 61 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 62 | branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 63 | 64 | MODA::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 65 | leaves=branches$leaves,weights=branches$weights, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 66 | 67 | ## ------------------------------------------------------------------------ 68 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 69 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 70 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 71 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 72 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 73 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 74 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 75 | 76 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 77 | Vertical, Broad, Wonderlic) 78 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 79 | names = qbdata$Name 80 | 81 | MAVF <- MODA::MAVF_Scores(SAVF_matrix, weights, names) 82 | knitr::kable(MAVF, digits = 4, row.names = FALSE, caption = "MAVF Scores") 83 | 84 | ## ----fig.asp=.75, fig.align='center', fig.cap="MAVF Breakout Graph", fig.width=6, fig.height=5---- 85 | Height <- MODA::SAVF_exp_score(qbdata$Height, 68, 75.21, 82, 1) 86 | Weight <- MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275, 1) 87 | Forty <- MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, 2) 88 | Shuttle <- MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, 2) 89 | Vertical <- MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40, 1) 90 | Broad <- MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130, 1) 91 | Wonderlic <- MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50, 1) 92 | 93 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 94 | Vertical, Broad, Wonderlic) 95 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 96 | names = qbdata$Name 97 | 98 | MODA::MAVF_breakout(SAVF_matrix, weights, names) 99 | 100 | ## ----fig.asp=.8, fig.align='center', fig.cap="Sensitivity Analysis", fig.width=6, fig.height=5---- 101 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 102 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 103 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 104 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 105 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 106 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 107 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 108 | 109 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 110 | Vertical, Broad, Wonderlic) 111 | 112 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 113 | 114 | MODA::sensitivity_plot(SAVF_matrix, weights, qbdata$Name, 4) 115 | 116 | -------------------------------------------------------------------------------- /inst/doc/MultiObjectiveDecisionAnalysisinR.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Multi Objective Decision Analysis in __R__" 3 | author: "Josh Deehr" 4 | output: rmarkdown::html_vignette 5 | vignette: > 6 | %\VignetteIndexEntry{Multi Objective Decision Analysis in __R__} 7 | %\VignetteEngine{knitr::rmarkdown} 8 | \usepackage[utf8]{inputenc} 9 | --- 10 | 11 | ## Prereqs 12 | \small 13 | This tutorial uses the MODA::NFLcombine dataset that came from NFLSavant.com. This is a database consisting of NFL Combine data from 1999 to 2015 and is documented in ?MODA::NFLcombine. This tutorial also requires the following packages: 14 | 15 | ```{r warning=FALSE, message=FALSE} 16 | library(dplyr) 17 | library(gridExtra) 18 | library(knitr) 19 | ``` 20 | 21 | ## Overview 22 | 23 | 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. 24 | 25 | 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. 26 | 27 | Currently there is very little out there for any multi criteria decision making in __R__. 28 | 29 | - `MCMD`: Package containing different methods for weighting and calculating of alternatives. Must calculate SAVF matrix before utilizing, offers no sensitivity analysis. 30 | - `KraljicMatrix`: Solves a specific instance of MCDM, but is not reproducible for other problems. 31 | 32 | ## MODA Method 33 | 34 | MODA consists of ten steps. In this tutorial, we will cover the bolded steps in greater detail. 35 | 36 | 1. Problem Identification 37 | 38 | 2. __Identifing and Structuring Objectives__ 39 | 40 | 3. Measuring the Achievement of Objectives 41 | 42 | 4. __Single Attribute Value Functions__ 43 | 44 | 5. __Multi Attribute Value Functions__ 45 | 46 | 6. Alternative Generation and Screening 47 | 48 | 7. __Alternative Scoring__ 49 | 50 | 8. __Determanistic Sensitivity__ 51 | 52 | 9. __Sensitivity Analysis__ 53 | 54 | 10. Communicating Results 55 | 56 | ## Test Data Set 57 | \small 58 | 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. 59 | 60 | \tiny 61 | ```{r } 62 | qbdata <- MODA::NFLcombine %>% 63 | filter(year == '2011', position == 'QB', wonderlic != '0') %>% 64 | select(c(2, 8, 9, 12, 15, 17, 18, 25, 20)) 65 | qbdata[qbdata == 0] = NA 66 | names(qbdata) <- c("Name", "Height", "Weight", "Forty", 67 | "Shuttle", "Vertical", "Broad", "Wonderlic", "Round") 68 | ``` 69 | 70 | ```{r echo=FALSE} 71 | knitr::kable(qbdata, caption = "Data") 72 | ``` 73 | 74 | 75 | ## Value Hierarchy 76 | \small 77 | 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 MODA package is used and the evaluation measures are the measurement criteria (height, weight, etc.) that we retained from the database. 78 | 79 | ```{r fig.cap="Value Hierarchy", fig.align='center', fig.width=7, fig.height=4} 80 | branches<- as.data.frame(matrix(ncol=4,nrow=7)) 81 | names(branches)<-c("Level1","Level2","Level3","leaves") 82 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty") 83 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle") 84 | branches[3,]<-rbind("QB","Size","","Height") 85 | branches[4,]<-rbind("QB","Size","","Weight") 86 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic") 87 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical") 88 | branches[7,]<-rbind("QB","Strength","Power","Broad") 89 | 90 | MODA::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 91 | leaves=branches$leaves, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 92 | 93 | ``` 94 | 95 | ## Value Measures 96 | \small 97 | 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. 98 | 99 | Below shows the table of value measures for out test data set: 100 | 101 | \tiny 102 | 103 | |Value Measure |Low |High |Measurement | 104 | |:--- |:--- |:--- |:--- | 105 | |Height |68 |82 |Total height in inches | 106 | |Weight |185 |275 |Total weight in pounds | 107 | |Forty Yard Dash|4.3 |5.4 |Time in seconds to run forty yards | 108 | |Shuttle Sprint |3.8 |4.9 |Time in seconds to complete shuttle sprint | 109 | |Vertical Jump |21 |40 |Height player jumped vertically in inches | 110 | |Broad Jump |90 |130 |Distance traveled during broad jump in inches | 111 | |Wonderlic Score|0 |50 |Raw score received on Wonderlic Test | 112 | Table: Value Measures 113 | 114 | ## Single Attribute Value Function 115 | \small 116 | 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. 117 | 118 | 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 MODA SAVF plot functions: 119 | 120 | ```{r warning=FALSE, fig.asp=.75, fig.align='center',fig.width=6, fig.height=5} 121 | a1 <- MODA::SAVF_exp_plot(90, 0, 120, 150) 122 | a2 <- MODA::SAVF_linear_plot(10, 0, 20, 100, FALSE) 123 | a3 <- MODA::SAVF_cat_plot(c("Tom", "Bill", "Jerry"), c(0.1, 0.25, 0.65)) 124 | gridExtra::grid.arrange(a1, a2, a3, ncol = 2) 125 | ``` 126 | 127 | 128 | ## SAVF Matrix 129 | \small 130 | 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 MODA `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. 131 | 132 | Below is the SAVF matrix for the test data set: 133 | \tiny 134 | 135 | ```{r } 136 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 137 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 138 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 139 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 140 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 141 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 142 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 143 | 144 | SAVF_matrix = cbind(qbdata$Name, Height, Weight, Forty, Shuttle, 145 | Vertical, Broad, Wonderlic) 146 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 147 | 148 | knitr::kable(SAVF_matrix, caption = "SAVF Scores") 149 | ``` 150 | 151 | ## Multi Attribute Value Function 152 | \small 153 | 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: 154 | 155 | ```{r, fig.align='center', fig.cap="Weighted Value Hierarchy",fig.width=7, fig.height=4} 156 | branches<- as.data.frame(matrix(ncol=5,nrow=7)) 157 | names(branches)<-c("Level1","Level2","Level3","leaves","weights") 158 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 159 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 160 | branches[3,]<-rbind("QB","Size","","Height","0.096") 161 | branches[4,]<-rbind("QB","Size","","Weight","0.224") 162 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 163 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 164 | branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 165 | 166 | MODA::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 167 | leaves=branches$leaves,weights=branches$weights, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 168 | ``` 169 | 170 | 171 | ## MAVF Scores 172 | \small 173 | 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. 174 | 175 | For example, taking Cam Newton from the test data set: 176 | 177 | \tiny 178 | (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 179 | 180 | \small 181 | Below shows all values from our test data set using the `MAVF_Scores` function: 182 | 183 | ```{r } 184 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 185 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 186 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 187 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 188 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 189 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 190 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 191 | 192 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 193 | Vertical, Broad, Wonderlic) 194 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 195 | names = qbdata$Name 196 | 197 | MAVF <- MODA::MAVF_Scores(SAVF_matrix, weights, names) 198 | knitr::kable(MAVF, digits = 4, row.names = FALSE, caption = "MAVF Scores") 199 | ``` 200 | 201 | ## Breakout Graph 202 | \small 203 | 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. 204 | 205 | The value breakout graph allows for a quick and easy comparison of how each attribute affected the alternatives. Using the MODA `MAVF_breakout` function the breakout graph below was created from the test data: 206 | 207 | ```{r fig.asp=.75, fig.align='center', fig.cap="MAVF Breakout Graph", fig.width=6, fig.height=5} 208 | Height <- MODA::SAVF_exp_score(qbdata$Height, 68, 75.21, 82, 1) 209 | Weight <- MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275, 1) 210 | Forty <- MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, 2) 211 | Shuttle <- MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, 2) 212 | Vertical <- MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40, 1) 213 | Broad <- MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130, 1) 214 | Wonderlic <- MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50, 1) 215 | 216 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 217 | Vertical, Broad, Wonderlic) 218 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 219 | names = qbdata$Name 220 | 221 | MODA::MAVF_breakout(SAVF_matrix, weights, names) 222 | ``` 223 | 224 | ## Sensitivity Analysis 225 | \small 226 | 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 MODA `sensitivity_plot` function, the sensitivity analysis plot for the shuttle criteria in the test set is below: 227 | 228 | ```{r fig.asp=.8, fig.align='center', fig.cap="Sensitivity Analysis", fig.width=6, fig.height=5} 229 | Height <- round(MODA::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 230 | Weight <- round(MODA::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 231 | Forty <- round(MODA::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 232 | Shuttle <- round(MODA::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 233 | Vertical <- round(MODA::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 234 | Broad <- round(MODA::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 235 | Wonderlic <- round(MODA::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 236 | 237 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 238 | Vertical, Broad, Wonderlic) 239 | 240 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 241 | 242 | MODA::sensitivity_plot(SAVF_matrix, weights, qbdata$Name, 4) 243 | ``` 244 | 245 | ## Practice Problems 246 | 247 | 1. Change the year to "2004", how many quarterbacks were at the combine? 248 | 249 | 2. Calculate the MAVF scores and include the round the QB was drafted, who was the highest ranked? 250 | 251 | 3. Does anything seem out of place? 252 | 253 | ## References 254 | 255 | Kirkwood, Craig W. _Strategic Decision Making_. Wadsworth Publishing Company, 1997. 256 | -------------------------------------------------------------------------------- /vignettes/MultiObjectiveDecisionAnalysisinR.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Multi Objective Decision Analysis in __R__" 3 | author: "Josh Deehr" 4 | output: rmarkdown::html_vignette 5 | vignette: > 6 | %\VignetteIndexEntry{Multi Objective Decision Analysis in __R__} 7 | %\VignetteEngine{knitr::rmarkdown} 8 | \usepackage[utf8]{inputenc} 9 | --- 10 | 11 | ## Prereqs 12 | \small 13 | 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: 14 | 15 | ```{r warning=FALSE, message=FALSE} 16 | knitr::opts_chunk$set(collapse = TRUE, 17 | fig.align = "center", 18 | options(bitmapType='cairo')) 19 | library(dplyr) 20 | library(gridExtra) 21 | library(knitr) 22 | library(Cairo) 23 | ``` 24 | 25 | ## Overview 26 | 27 | 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. 28 | 29 | 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. 30 | 31 | Currently there is very little out there for any multi criteria decision making in __R__. 32 | 33 | - `MCMD`: Package containing different methods for weighting and calculating of alternatives. Must calculate SAVF matrix before utilizing, offers no sensitivity analysis. 34 | - `KraljicMatrix`: Solves a specific instance of MCDM, but is not reproducible for other problems. 35 | 36 | ## MODA Method 37 | 38 | MODA consists of ten steps. In this tutorial, we will cover the bolded steps in greater detail. 39 | 40 | 1. Problem Identification 41 | 42 | 2. __Identifing and Structuring Objectives__ 43 | 44 | 3. Measuring the Achievement of Objectives 45 | 46 | 4. __Single Attribute Value Functions__ 47 | 48 | 5. __Multi Attribute Value Functions__ 49 | 50 | 6. Alternative Generation and Screening 51 | 52 | 7. __Alternative Scoring__ 53 | 54 | 8. __Determanistic Sensitivity__ 55 | 56 | 9. __Sensitivity Analysis__ 57 | 58 | 10. Communicating Results 59 | 60 | ## Test Data Set 61 | \small 62 | 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. 63 | 64 | \tiny 65 | ```{r } 66 | qbdata <- DecisionAnalysis::NFLcombine %>% 67 | filter(year == '2011', position == 'QB', wonderlic != '0') %>% 68 | select(c(2, 8, 9, 12, 15, 17, 18, 25, 20)) 69 | qbdata[qbdata == 0] = NA 70 | names(qbdata) <- c("Name", "Height", "Weight", "Forty", 71 | "Shuttle", "Vertical", "Broad", "Wonderlic", "Round") 72 | ``` 73 | 74 | ```{r echo=FALSE} 75 | knitr::kable(qbdata, caption = "Data") 76 | ``` 77 | 78 | 79 | ## Value Hierarchy 80 | \small 81 | 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. 82 | 83 | ```{r fig.cap="Value Hierarchy", fig.align='center', fig.width=7, fig.height=4} 84 | branches<- as.data.frame(matrix(ncol=4,nrow=7)) 85 | names(branches)<-c("Level1","Level2","Level3","leaves") 86 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty") 87 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle") 88 | branches[3,]<-rbind("QB","Size","","Height") 89 | branches[4,]<-rbind("QB","Size","","Weight") 90 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic") 91 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical") 92 | branches[7,]<-rbind("QB","Strength","Power","Broad") 93 | 94 | DecisionAnalysis::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 95 | leaves=branches$leaves, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 96 | 97 | ``` 98 | 99 | ## Value Measures 100 | \small 101 | 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. 102 | 103 | Below shows the table of value measures for out test data set: 104 | 105 | \tiny 106 | 107 | |Value Measure |Low |High |Measurement | 108 | |:--- |:--- |:--- |:--- | 109 | |Height |68 |82 |Total height in inches | 110 | |Weight |185 |275 |Total weight in pounds | 111 | |Forty Yard Dash|4.3 |5.4 |Time in seconds to run forty yards | 112 | |Shuttle Sprint |3.8 |4.9 |Time in seconds to complete shuttle sprint | 113 | |Vertical Jump |21 |40 |Height player jumped vertically in inches | 114 | |Broad Jump |90 |130 |Distance traveled during broad jump in inches | 115 | |Wonderlic Score|0 |50 |Raw score received on Wonderlic Test | 116 | Table: Value Measures 117 | 118 | ## Single Attribute Value Function 119 | \small 120 | 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. 121 | 122 | 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: 123 | 124 | ```{r warning=FALSE, fig.asp=.75, fig.align='center',fig.width=6, fig.height=5} 125 | a1 <- DecisionAnalysis::SAVF_exp_plot(90, 0, 120, 150) 126 | a2 <- DecisionAnalysis::SAVF_linear_plot(10, 0, 20, 100, FALSE) 127 | a3 <- DecisionAnalysis::SAVF_cat_plot(c("Tom", "Bill", "Jerry"), c(0.1, 0.25, 0.65)) 128 | gridExtra::grid.arrange(a1, a2, a3, ncol = 2) 129 | ``` 130 | 131 | 132 | ## SAVF Matrix 133 | \small 134 | 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. 135 | 136 | Below is the SAVF matrix for the test data set: 137 | \tiny 138 | 139 | ```{r} 140 | Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 141 | Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 142 | Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 143 | Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 144 | Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 145 | Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 146 | Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 147 | 148 | SAVF_matrix = cbind(qbdata$Name, Height, Weight, Forty, Shuttle, 149 | Vertical, Broad, Wonderlic) 150 | SAVF_matrix[is.na(SAVF_matrix)] <- 0 151 | 152 | knitr::kable(SAVF_matrix, caption = "SAVF Scores") 153 | ``` 154 | 155 | ## Multi Attribute Value Function 156 | \small 157 | 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: 158 | 159 | ```{r, fig.align='center', fig.cap="Weighted Value Hierarchy",fig.width=7, fig.height=4} 160 | branches<- as.data.frame(matrix(ncol=5,nrow=7)) 161 | names(branches)<-c("Level1","Level2","Level3","leaves","weights") 162 | branches[1,]<-rbind("QB","Elusiveness","Speed","Forty","0.092") 163 | branches[2,]<-rbind("QB","Elusiveness","Agility","Shuttle","0.138") 164 | branches[3,]<-rbind("QB","Size","","Height","0.096") 165 | branches[4,]<-rbind("QB","Size","","Weight","0.224") 166 | branches[5,]<-rbind("QB","Intelligence","","Wonderlic","0.07") 167 | branches[6,]<-rbind("QB","Strength","Explosiveness","Vertical","0.152") 168 | branches[7,]<-rbind("QB","Strength","Power","Broad","0.228") 169 | 170 | DecisionAnalysis::value_hierarchy_tree(branches$Level1,branches$Level2,branches$Level3, 171 | leaves=branches$leaves,weights=branches$weights, nodefillcolor = "LightBlue", leavesfillcolor = "Blue", leavesfontcolor = "White") 172 | ``` 173 | 174 | 175 | ## MAVF Scores 176 | \small 177 | 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. 178 | 179 | For example, taking Cam Newton from the test data set: 180 | 181 | \tiny 182 | (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 183 | 184 | \small 185 | Below shows all values from our test data set using the `MAVF_Scores` function: 186 | 187 | ```{r} 188 | Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 189 | Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 190 | Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 191 | Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 192 | Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 193 | Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 194 | Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 195 | 196 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 197 | Vertical, Broad, Wonderlic) 198 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 199 | names = qbdata$Name 200 | 201 | MAVF <- DecisionAnalysis::MAVF_Scores(SAVF_matrix, weights, names) 202 | knitr::kable(MAVF, digits = 4, row.names = FALSE, caption = "MAVF Scores") 203 | ``` 204 | 205 | ## Breakout Graph 206 | \small 207 | 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. 208 | 209 | 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: 210 | 211 | ```{r fig.asp=.75, fig.align='center', fig.cap="MAVF Breakout Graph", fig.width=6, fig.height=5} 212 | Height <- DecisionAnalysis::SAVF_exp_score(qbdata$Height, 68, 75.21, 82, 1) 213 | Weight <- DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275, 1) 214 | Forty <- DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, 2) 215 | Shuttle <- DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, 2) 216 | Vertical <- DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40, 1) 217 | Broad <- DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130, 1) 218 | Wonderlic <- DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50, 1) 219 | 220 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 221 | Vertical, Broad, Wonderlic) 222 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 223 | names = qbdata$Name 224 | 225 | DecisionAnalysis::MAVF_breakout(SAVF_matrix, weights, names) 226 | ``` 227 | 228 | ## Sensitivity Analysis 229 | \small 230 | 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: 231 | 232 | ```{r fig.asp=.8, fig.align='center', fig.cap="Sensitivity Analysis", fig.width=6, fig.height=5} 233 | Height <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Height , 68, 75.21, 82), 3) 234 | Weight <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Weight, 185, 224.34, 275), 3) 235 | Forty <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Forty, 4.3, 4.81, 5.4, FALSE), 3) 236 | Shuttle <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Shuttle, 3.8, 4.3, 4.9, FALSE), 3) 237 | Vertical <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Vertical, 21, 32.04, 40), 3) 238 | Broad <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Broad, 90, 111.24, 130), 3) 239 | Wonderlic <- round(DecisionAnalysis::SAVF_exp_score(qbdata$Wonderlic, 0, 27.08, 50), 3) 240 | 241 | SAVF_matrix = cbind(Height, Weight, Forty, Shuttle, 242 | Vertical, Broad, Wonderlic) 243 | 244 | weights = c(0.096, 0.224, 0.092, 0.138, 0.152, 0.228, 0.07) 245 | 246 | DecisionAnalysis::sensitivity_plot(SAVF_matrix, weights, qbdata$Name, 4) 247 | ``` 248 | 249 | ## Practice Problems 250 | 251 | 1. Change the year to "2004", how many quarterbacks were at the combine? 252 | 253 | 2. Calculate the MAVF scores and include the round the QB was drafted, who was the highest ranked? 254 | 255 | 3. Does anything seem out of place? 256 | 257 | ## References 258 | 259 | Kirkwood, Craig W. _Strategic Decision Making_. Wadsworth Publishing Company, 1997. 260 | --------------------------------------------------------------------------------