Skip to main content
 首页 » 编程设计

R语言实现层次分析法确定指标权重

2022年07月19日222txw1958

层次分析法(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
阅读延展