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)
lmdaci <- (lmda-length(bw)) / (length(bw) -1)
cicr <- 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]))
}