R语言学习笔记——确定指标权重：层次分析法/熵权法/CRITIC方法

本文介绍使用R语言确定指标权重的方法，包括：层次分析法、熵权法和CRITIC方法，内容包含了逆向指标正向化处理。

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

# 定义归一化函数
std <- 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 #cr = 0.025 < 0.10，一致性检验通过, 因此上述 w 的权重是合理的。

2、熵权法

####### 熵权法 ######
#### method 1####
## 定义归一化函数
rescale = function(x, type = "pos", a = 0, b = 1) {
  rng = range(x, na.rm = TRUE)
  switch (type,
          "pos" = (b - a) * (x - rng[1]) / (rng[2] - rng[1]) + a,
          "neg" = (b - a) * (rng[2] - x) / (rng[2] - rng[1]) + a)
}

Entropy_Weight = function(X, index = NULL) {
  # 实现用熵权法计算各指标(列)的权重及各数据行的得分
  # X为原始指标数据, 一行代表一个样本, 每列对应一个指标
  # index指示各指标列的正负向, "pos"表示正向, "neg"表示负向, 默认都是正向指标
  # s返回各行（样本）得分，w返回各列权重
  if(is.null(index)) index = rep("pos", ncol(X))
  pos = which(index == "pos")
  neg = which(index == "neg")
  # 数据归一化
  X[,pos] = lapply(X[,pos, drop = FALSE], rescale, a = 0.002, b = 0.996)
  X[,neg] = lapply(X[,neg, drop = FALSE], rescale, type = "neg", a = 0.002, b = 0.996)
  # 计算第j个指标下，第i个样本占该指标的比重p(i,j)
  P = data.frame(lapply(X, \(x) x / sum(x)))
  # 计算第j个指标的熵值e(j)
  e = sapply(P, \(x) sum(x * log(x)) *(-1/log(nrow(P))))
  d = 1 - e          # 计算信息熵冗余度
  w = d / sum(d)    # 计算权重向量
  # 计算样本得分
  s = as.vector(100 * as.matrix(X) %*% w)
  list(w = w, s = s)
}
x<-data.frame(matrix(rep(1:100),nrow=10))
#a<-c(rep(1,10))
#x<-cbind(x,a)
ind = c(rep("pos",10))
#ind = c(rep("pos",11))
Entropy_Weight(x,ind)$w

#### method 2####
entropy_weights <- function(r_ij) {
  # 输入参数r_ij为一个m*n的纯数值矩阵；其中m代表样本量（行数），n代表指标数（列数）
  # 如果对象类型为数据框（dataframe），可以先使用as.matrix()函数将其转换成矩阵
  stopifnot(is.matrix(r_ij), is.numeric(r_ij)) # 如果输入不是纯数值矩阵，则终止程序
  m <- nrow(r_ij)
  n <- ncol(r_ij)
  k <- 1 / log(m)
  f_ij <- t(t(r_ij) / colSums(r_ij))
  H_j <- -k * colSums(f_ij * ifelse(f_ij == 0, 0, log(f_ij)))
  w <- (1 - H_j) / (n - sum(H_j))
  w
}
x<-(matrix(rep(1:100),nrow=10))
nor_min_max=function(x){
  y=na.omit(x)
  return((x - min(y))/(max(y) - min(y)))
}
dfmin_max = apply(x, 2,nor_min_max)
#dfmin_max<-cbind(dfmin_max,rep(1,10))
entropy_weights(dfmin_max)

3、CRITIC法

##### CRITIC法 ####
data<-data.frame(matrix(rep(1:100),nrow=10))
colnames(data)<-c("c1","c2","c3","c4","c5","c6","c7","c8","c9","c10")
the <- apply(data, 2, sd)  # Contrast
data3 <- data  # Make a copy of the data
#data3 <- t(data3)  # Transpose the matrix
r <- cor(data3, method = "pearson")  # Pearson correlation coefficient
f <- rowSums(1 - r)  # Sum of 1 - r
# Calculate weights
c <- the * f
w <- c / sum(c)  # Normalize weights
label_need<-data %>% names()
for(k in 1:length(label_need)){
  print(paste(label_need[k],"指标的CRITIC权重分别为：",w[k]))
}