层次分析法(Analyt Hierarchy Process，缩写AHP)是将决策有关的元素分解成目标、准指、方案等层次，在次基础上进行定性和定量分析的决策方法。本文通过一个示例描述R的实现过程。
概述
层次分析法计算指标权重的基本思路是，首先建立有效的递阶指标系统，然后主管地将指标两两对比构造判定矩阵，再根据判定矩阵进行数字处理及一致性检验，就可获得各个指标的相对重要性权数。
例子：
在地区间宏观经济效益评价中，选取资金利税率(x1)、投资效果系数(x2)和劳动生产率(x3)三项指标。某专家认为，资金利税率比劳动生产率极端重要，比投资效果系数稍重要，而投资效果系数比劳动生产率重要。试根据这位专家的判断确定三项评价指标的权数。
| 指标 | X1 | X2 | X3 |
|---|---|---|---|
| X1 | 1 | 3 | 9 |
| X2 | 1/3 | 1 | 5 |
| X3 | 1/9 | 1/5 | 1 |
tibble存储判定矩阵
options(digits = 2)
library(tidyverse)
macro <- tibble(x1=c(1,1/3,1/9), x2=c(3,1,1/5), x3=c(9,5,1))
macro
# A tibble: 3 x 3
# x1 x2 x3
# <dbl> <dbl> <dbl>
# 1 1 3 9
# 2 0.333 1 5
# 3 0.111 0.2 1
计算行向几何平均
即计算行数据成绩，然后再求行积结果的P次方根，即行向几何平均。
# 增加w变量
macro %>% mutate(w = '^'(x1*x2*x3, 1/3)) -> macro
macro
# A tibble: 3 x 4
# x1 x2 x3 w
# <dbl> <dbl> <dbl> <dbl>
# 1 1 3 9 3
# 2 0.333 1 5 1.19
# 3 0.111 0.2 1 0.281
对w变量归一化处理
w变量中的值除以w列向量之和。
# 定义归一化函数
std <- function(x){
x / sum(x)
}
# 通过归一化计算权重
macro %>% mutate_at(c("w"), .funs = std) -> macro
macro
# A tibble: 3 x 4
# x1 x2 x3 w
# <dbl> <dbl> <dbl> <dbl>
# 1 1 3 9 0.672
# 2 0.333 1 5 0.265
# 3 0.111 0.2 1 0.0629
下面要对三个变量的权重进行检验
一致性检验
一致性检验保证各指标的相对重要程度的判定要协调一致，不要出现相互矛盾的现象。
判定矩阵B具有一致性的条件是矩阵B的最大特征根等于指标的个数。
计算过程如下：
options(digits = 2)
library(tidyverse)
# 随机一致性表
ri_table <- c(0, 0, 0.58, 0.89, 1.12, 1.26, 1.36, 1.41, 1.46, 1.49, 1.52,1.54)
b <- as.matrix(macro[,-4])
w <- as.matrix(macro[,4])
## 矩阵乘积
bw <- b %*% w
## 最大特征根
lmda <- 1/3 * sum(bw / w)
lmda
## 一致性指标CI
ci <- (lmda-length(bw)) / (length(bw) -1)
ci
## 一致性比率CR
cr <- ci / ri_table[length(bw)]
cr
# [1] 0.025
# cr = 0.025 < 0.10，一致性检验通过, 上述 w 的权重是合理的
# w
# [1,] 0.672
# [2,] 0.265
# [3,] 0.063
cr = 0.025 < 0.10，一致性检验通过, 因此上述 w 的权重是合理的。
最终计算X1(67%), X2(27%), X3(6%),三个变量权重总和等于1.
完整代码
options(digits = 2)
library(tidyverse)
macro <- tibble(x1=c(1,1/3,1/9), x2=c(3,1,1/5), x3=c(9,5,1))
macro %>% mutate(w = '^'(x1*x2*x3, 1/3)) -> macro
macro
# 定义归一化函数
unif <- function(x){
x / sum(x)
}
# 通过归一化计算权重
macro %>% mutate_at(c("w"), .funs = std) -> macro
macro
# 随机一致性表
ri_table <- c(0, 0, 0.58, 0.89, 1.12, 1.26, 1.36, 1.41, 1.46, 1.49, 1.52,1.54)
# 一致性检验
b <- as.matrix(macro[,-4])
w <- as.matrix(macro[,4])
bw <- b %*% w
lmda <- 1/3 * sum(bw / w)
lmda
ci <- (lmda-length(bw)) / (length(bw) -1)
ci
cr <- ci / ri_table[length(bw)]
cr
本文参考链接：https://blog.csdn.net/neweastsun/article/details/122006194
