层次分析法(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的最大特征根等于指标的个数。

计算过程如下：

r语言进行层次聚类 r语言 层次分析法_r语言进行层次聚类

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