R语言构建层次分析模型不看一下吗~

2020-06-16 00:00:00 方案向量层次矩阵特征值

AHP (Analytic Hierarchy Process)层次分析法是美国运筹学家Saaty教授于二十世纪80年代提出的一种实用的多方案或多目标的决策方法。其主要特征是，它合理地将定性与定量的决策结合起来，按照思维、心理的规律把决策过程层次化、数量化。

层次分析法的基本思路：先分解后综合

首先将所要分析的问题层次化，根据问题的性质和要达到的总目标，将问题分解成不同的组成因素，按照因素间的相互关系及隶属关系，将因素按不同层次聚集组合，形成一个多层分析结构模型，终归结为低层（方案、措施、指标等）相对于高层（总目标）相对重要程度的权值或相对优劣次序的问题。
用AHP分析问题大体要经过以下五个步骤：

（1）建立层次结构模型；
（2）构造判断矩阵；
（3）层次单排序；
（4）一致性检验；
（5）层次总排序。

其中后三个步骤在整个过程中需要逐层地进行。
以下是一个情景案例：

假期你想要出去旅游，现有三个目的地（方案）：
古风古韵的西安（P1）；
天府之国的成都（P2）；
如诗如画的杭州（P3）。

假如选择的标准和依据（行动方案准则）有5个：

景色，费用，饮食，居住和旅途。
则常规思维的方式一般是：

1、先确定这些准则在心中的各自占比的大小；
2、然后就每一准则将三个地点进行比较；
3、后将这两个层次的比较判断进行综合，做出选择。

以下是根据分析思路构建的层次分析法结构模型：

以上结构模型中，我们需要比较准侧层各个准则相对于目标的权重，同时也要比较方案层各个方案相对于准侧层每一个准则的权重。
权重的判断建立在专家打分的基础上，即通过一组打分标准，来赋予单层各个指标的相对权重。
这里的打分机制使用1~9标度法：

1代表两个元素相比，具有相同的重要性；
3代表两个元素相比，前者比后者稍重要；
5代表两个元素相比，前者比后者明显重要；
7代表两个元素相比，前者比后者极其重要；
9代表两个元素相比，前者比后者强烈重要
2，4，6，8表示上述相邻判断的中间值。

以上准则层的5个指标依次是：
景色：C1
费用：C2
居住：C3
饮食：C4
旅途：C5
相对于目标层：选择旅游地，进行两两比较打分。
景色费用居住饮食旅途
C1 C2 C3 C4 C5
C1 1 1/2 4 3 3
C2 2 1 7 5 5
C3 1/4 1/7 1 1/2 1/3
C4 1/3 1/5 2 1 1
C5 1/3 1/5 2 1 1

构造所有相对于不同准则的方案层判断矩阵

相对于景色
P1 p2 p3
P1 1 2 5
P2 1/2 1 2
P3 1/5 1/2 1

相对于费用
P1 p2 p3
P1 1 1/3 1/8
P2 3 1 1/3
P3 8 3 1

相对于居住
P1 p2 p3
P1 1 1 3
P2 1 1 3
P3 1/3 1/3 1
相对于饮食

P1 p2 p3
P1 1 3 4
P2 1/3 1 1
P3 1/4 1 1

相对于旅途
P1 P2 P3
P1 1 1 1/4
P2 1 1 1/4
P3 4 4 4

以下是整个层次分析法的整个建模流程：

#清空R语言环境内存

rm(list = ls())
gc()

#加载包

library("readxl")
library("dplyr")
library("magrittr")
准则层：
C1——景色
C2——费用
C3——居住
C4——饮食
C5——旅途


方案层：
P1——西安
P2——成都
P3——杭州

准则层与方案层的判定矩阵:（专（hu）家 (luan) 打 (tian) 分 (xie) ）
#准则层判断矩阵
data_C <- matrix(
  c(1,2,1/4,1/3,1/3,1/2,1,1/7,1/5,1/5,4,7,1,2,3,3,5,1/2,1,1,3,5,1/3,1,1),
  nrow = 5,
  dimnames = list(c("C1","C2","C3","C4","C5"),c("C1","C2","C3","C4","C5"))
)

#景色判断矩阵
data_B1 <- matrix(
  c(1,1/2,1/5,2,1,1/2,5,2,1),
  nrow = 3,
  dimnames = list(c("P1","P2","P3"),c("P1","P2","P3"))
)

#费用判断矩阵
data_B2 <- matrix(
  c(1,3,8,1/3,1,3,1/8,1/3,1),
  nrow = 3,
  dimnames = list(c("P1","P2","P3"),c("P1","P2","P3"))
)

#居住判断矩阵
data_B3 <- matrix(
  c(1,1,1/3,1,1,1/3,3,3,1),
  nrow = 3,
  dimnames = list(c("P1","P2","P3"),c("P1","P2","P3"))
)

#饮食判断矩阵
data_B4 <- matrix(
  c(1,1/3,1/4,3,1,1,4,1,1),
  nrow = 3,
  dimnames = list(c("P1","P2","P3"),c("P1","P2","P3"))
)

#路途判断矩阵
data_B5 <- matrix(
  c(1,1,4,1,1,4,1/4,1/4,1),
  nrow = 3,
  dimnames = list(c("P1","P2","P3"),c("P1","P2","P3"))
)
准侧层判别过程：
1、判断矩阵归一化：
Weigth_fun <- function(data){
 if(class(data) == 'matrix'){
      data = data     
  } else {
 if ( class(data) == 'data.frame' & nrow(data) == ncol(data) - 1 & is.character(data[,1,drop = TRUE])){
      data = as.matrix(data[,-1])
    } else if (class(data) == 'data.frame' & nrow(data) == ncol(data)) {
      data = as.matrix(data)
    } else {
 stop('please recheck your data structure , you must keep a equal num of the row and col')
    }    
  }
  sum_vector_row    =  data %>% apply(2,sum)
  decide_matrix     =  data %>% apply(1,function(x) x/sum_vector_row) 
  weigth_vector     =  decide_matrix %>% apply(2,sum)
  result = list(decide_matrix = decide_matrix, weigth_vector  = weigth_vector/sum(weigth_vector ))
 return(result)
}

Weigth_fun(data_C)

相关文章