r语言熵权法求权重（真实案例完整流程）

基本原理

在信息论中，熵是对不确定性的一种度量。信息量越大，不确定性就越小，熵也就越小；信息量越小，不确定性越大，熵也越大。

根据熵的特性，可以通过计算熵值来判断一个事件的随机性及无序程度，也可以用熵值来判断某个指标的离散程度，指标的离散程度越大，该指标对综合评价的影响（权重）越大。比如样本数据在某指标下取值都相等，则该指标对总体评价的影响为0，权值为0.

熵权法是一种客观赋权法，因为它仅依赖于数据本身的离散性。

熵权法步骤

第一步：指标的归一化处理（异质指标同质化）：由于各项指标的计量单位并不统一，因此在用他们计算综合指标前，先要进行标准化处理，即把指标的绝对值转化为相对值，从而解决各项不同质指标值的同质化问题。

另外，正向指标和负向指标数值代表的含义不同（正向指标数值越高越好，负向指标数值越低越好），因此，对于正向、负向指标需要采用不同的算法进行数据标准化处理。

正向指标：xij′=xij−min⁡{x1j,…,xnj}max⁡{x1j,…,xrj}−min⁡{x1j,…,xnj}x_{i j}^{\prime}=\frac{x_{i j}-\min \left\{x_{1 j}, \ldots, x_{n j}\right\}}{\max \left\{x_{1 j}, \ldots, x_{r j}\right\}-\min \left\{x_{1 j}, \ldots, x_{n j}\right\}}xij′=max{x1j,…,xrj}−min{x1j,…,xnj}xij−min{x1j,…,xnj}

负向指标：xij′=max⁡{x1j,…,xnj}−xijmax⁡{x1j,…,xrj}−min⁡{x1j,…,xnj}x_{i j}^{\prime}=\frac{\max \left\{x_{1 j}, \ldots, x_{n j}\right\}-x_{i j}}{\max \left\{x_{1 j}, \ldots, x_{r j}\right\}-\min \left\{x_{1 j}, \ldots, x_{n j}\right\}}xij′=max{x1j,…,xrj}−min{x1j,…,xnj}max{x1j,…,xnj}−xij

第二步：计算第j项指标下第i个样本值占该指标的比重 pij=xij∑i=1nxij,i=1,⋯,n,j=1,⋯,mp_{i j}=\frac{x_{i j}}{\sum_{i=1}^{n} x_{i j}}, \quad i=1, \cdots, n, j=1, \cdots, mpij=∑i=1nxijxij,i=1,⋯,n,j=1,⋯,m

第三步：计算第j项指标的熵值 ej=−k∑i=1npijln⁡(pij),j=1,⋯,me_{j}=-k \sum_{i=1}^{n} p_{i j} \ln \left(p_{i j}\right), \quad j=1, \cdots, mej=−ki=1∑npijln(pij),j=1,⋯,m 其中 k=1/ln⁡(n)>0k=1 / \ln (n)>0k=1/ln(n)>0 ，满足 ej≥0e_{j} \geq 0ej≥0。

第四步：计算信息熵冗余度（差异） dj=1−ej,j=1,⋯,md_{j}=1-e_{j}, \quad j=1, \cdots, mdj=1−ej,j=1,⋯,m

第五步：计算各项指标的权重 wj=dj∑j=1mdj,j=1,⋯,mw_{j}=\frac{d_{j}}{\sum_{j=1}^{m} d_{j}}, \quad j=1, \cdots, mwj=∑j=1mdjdj,j=1,⋯,m

第六步：计算各样本的综合得分 si=∑j=1mwjxij,i=1,⋯,ns_{i}=\sum_{j=1}^{m} w_{j} x_{i j}, \quad i=1, \cdots, nsi=j=1∑mwjxij,i=1,⋯,n 其中， xijx_{i j}xij 为标准化后的数据。

脚本实现

数据读入。

library(forecast)
library(XLConnect)
sourui <- read.csv("E:/R/operation/train.csv",header = T)

部分数据展现

索引列删除

sourui$案例 <- NULL

第一步：归一化处理。

min.max.norm <- function(x){(x-min(x))/(max(x)-min(x))
}max.min.norm <- function(x){(max(x)-x)/(max(x)-min(x))
}sourui_1 <- apply(sourui[,-c(7,11)],2,min.max.norm)  #正向指标
sourui_2 <- apply(sourui[,c(7,11)],2,max.min.norm)   #负向指标sourui_t <- cbind(sourui_1,sourui_2)

第二步：求出所有样本对指标Xj的贡献总量

first1 <- function(data)
{x <- c(data)for(i in 1:length(data))x[i] = data[i]/sum(data[])return(x)
}
dataframe <- apply(sourui_t,2,first1)

第三步：将上步生成的矩阵每个元素变成每个元素与该ln（元素）的积并计算信息熵。

first2 <- function(data)
{x <- c(data)for(i in 1:length(data)){if(data[i] == 0){x[i] = 0}else{x[i] = data[i] * log(data[i])}}return(x)
}
dataframe1 <- apply(dataframe,2,first2)k <- 1/log(length(dataframe1[,1]))
d <- -k * colSums(dataframe1)

第四步：计算冗余度。

d <- 1-d

第五步：计算各项指标的权重。

w <- d/sum(d)
w

最终输出结果展现，输出的为各项指标的权重得分

应用：基于各指标及权重值，可以对每个样本计算线性得分（使用归一化后数据）

实现：

sourui$评分 <- 0 for (i in 1:13){ sourui$评分 <- sourui$评分 + dataframe0[,i] * w1[i,] }