From 8b6b7e060bbf3de9195272983ad33f6b299b1354 Mon Sep 17 00:00:00 2001
From: Matt Stinson <matt@Matts-MacBook-Pro.local>
Date: Sat, 4 Mar 2017 12:27:41 -0600
Subject: [PATCH 1/2] commit

---
 R/ahp_functions.R | 60 +++++++++++++++++++++++++++++------------------
 1 file changed, 37 insertions(+), 23 deletions(-)

diff --git a/R/ahp_functions.R b/R/ahp_functions.R
index de2d2f2..1fbdfaf 100644
--- a/R/ahp_functions.R
+++ b/R/ahp_functions.R
@@ -20,20 +20,20 @@ RI <- function(n){
 }
 
 #' Calculate the ahp priority weights from the AHP matrix.
-#' 
-#' For a comparison of different methods, see for example \bold{How to derive priorities in AHP: a comparative study}, 
+#'
+#' For a comparison of different methods, see for example \bold{How to derive priorities in AHP: a comparative study},
 #' by Alessio Ishizaka and Markus Lusti, as available here: http://eprints.port.ac.uk/9041/1/filetodownload,70633,en.pdf
-#' 
+#'
 #' @param mat The AHP preference matrix
-#' @param allowedConsistency if the AHP consistency ratio is larger 
+#' @param allowedConsistency if the AHP consistency ratio is larger
 #' than this value, AHP is not applied and equal weights are returned.
 #' @return the ahp preference weights
-#' 
+#'
 #' @export
-PrioritiesFromPairwiseMatrixEigenvalues <- function(mat, allowedConsistency = 1) { 
+PrioritiesFromPairwiseMatrixEigenvalues <- function(mat, allowedConsistency = 1) {
   # weigthing vector
   eig <- eigen(mat, symmetric=FALSE)
-  
+
   #consistency
   M22 = mat/kronecker(matrix(1, dim(mat)[1], 1), t(apply(mat, 2, sum)))
   w = apply(M22, 1, sum) / dim(mat)[1]
@@ -48,31 +48,48 @@ PrioritiesFromPairwiseMatrixEigenvalues <- function(mat, allowedConsistency = 1)
 }
 
 #' @rdname PrioritiesFromPairwiseMatrixEigenvalues
-#' 
+#'
 #' @export
-PrioritiesFromPairwiseMatrixMeanNormalization <- function(mat) {
+PrioritiesFromPairwiseMatrixMeanNormalization <- function(mat, allowedConsistency = 1) {
+  # weigthing vector
   priority <- rowMeans( mat / matrix(rep(colSums(mat), nrow(mat)), nrow = nrow(mat), byrow = TRUE))
-  list(priority = priority, consistency = NA)
+
+  #consistency
+  lambdaMax <- mean((mat %*% priority)/priority) # estimate
+  CI = (lambdaMax - dim(mat)[1]) / (dim(mat)[1]-1)
+  CR = CI / RI(dim(mat)[1])
+  CR <- max(CR, 0) #due to numerical inprecision
+  if (!(is.nan(CI) || CR < allowedConsistency)) priority <- (matrix(1/dim(mat)[1],1,dim(mat)[1]))
+  names(priority) <- dimnames(mat)[[1]]
+  list(priority = priority, consistency = CR)
 }
 
 
 #' @rdname PrioritiesFromPairwiseMatrixEigenvalues
-#' 
+#'
 #' @export
-PrioritiesFromPairwiseMatrixGeometricMean <- function(mat) {
+PrioritiesFromPairwiseMatrixGeometricMean <- function(mat, allowedConsistency = 1) {
   geometricMean <- apply(mat, MARGIN = 1, prod) ^ (1 / nrow(mat))
   priority <- geometricMean / sum(geometricMean)
-  list(priority = priority, consistency = NA)
+
+  #consistency
+  lambdaMax <- mean((mat %*% priority)/priority) # estimate
+  CI = (lambdaMax - dim(mat)[1]) / (dim(mat)[1]-1)
+  CR = CI / RI(dim(mat)[1])
+  CR <- max(CR, 0) #due to numerical inprecision
+  if (!(is.nan(CI) || CR < allowedConsistency)) priority <- (matrix(1/dim(mat)[1],1,dim(mat)[1]))
+  names(priority) <- dimnames(mat)[[1]]
+  list(priority = priority, consistency = CR)
 }
 
 
 #' Create the AHP preference matrix from a dataframe containing
-#' the pairwiswe preferences. 
-#' 
+#' the pairwiswe preferences.
+#'
 #' @param preferenceCombinations a data.frame containing category or alternative
 #' A in the first column, B in the second colum, and the preference in the third column.
 #' @return an AHP preference matrix
-#' 
+#'
 #' @export
 AhpMatrix <- function(preferenceCombinations) {
   cats <- unlist(unique(c(preferenceCombinations[,1], preferenceCombinations[,2])))
@@ -86,18 +103,15 @@ AhpMatrix <- function(preferenceCombinations) {
 
 
 #' Converts a vector of scores into priority weights.
-#' 
-#' While pure AHP limits itself to pairwise preferences, scoring alternatives 
+#'
+#' While pure AHP limits itself to pairwise preferences, scoring alternatives
 #' on an arbitrary scale is often much less time consuming in practice. This method
 #' calculates the priority weight as \code{score / sum(scores)}
-#' 
+#'
 #' @param scores a vector of scores
 #' @return a vector of priority weights
-#' 
+#'
 #' @export
 PrioritiesFromScoresDefault <- function(scores) {
   return (scores / sum(scores))
 }
-
-
-

From 951296f6d64ae1ded91692fbb4c9021f526d4750 Mon Sep 17 00:00:00 2001
From: MrMatt2532 <mrmatt2532@gmail.com>
Date: Mon, 6 Mar 2017 14:25:05 -0600
Subject: [PATCH 2/2] Update test-Analyze.R

Now handles consistency checks for geometric mean calculation.
---
 tests/testthat/test-Analyze.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-Analyze.R b/tests/testthat/test-Analyze.R
index 2c5ec97..860d674 100644
--- a/tests/testthat/test-Analyze.R
+++ b/tests/testthat/test-Analyze.R
@@ -8,8 +8,8 @@ test_that("Analyze Identity", {
   Calculate(carAhp, pairwiseFun = PrioritiesFromPairwiseMatrixGeometricMean)
   df <- Analyze(carAhp)
   
-  expect_equal(ncol(df), 8)
-  expect_equal(names(df), c(" ", "Weight", "Odyssey", "Accord Sedan", "CR-V", "Element", "Accord Hybrid", "Pilot"))
+  expect_equal(ncol(df), 9)
+  expect_equal(names(df), c(" ", "Weight", "Odyssey", "Accord Sedan", "CR-V", "Element", "Accord Hybrid", "Pilot", "Inconsistency"))
   
 })