按照信息论基本原理的解释，信息是系统有序程度的一个度量，熵是系统无序程度的一个度量；根据信息熵的定义，对于某项指标，可以用熵值来判断某个指标的离散程度，其信息熵值越小，指标的离散程度越大，该指标对综合评价的影响（即权重）就越大，如果某项指标的值全部相等，则该指标在综合评价中不起作用。因此，可利用信息熵这个工具，计算出各个指标的权重，为多指标综合评价提供依据。
熵权法
物理学上指热能除以温度所得的商，标志热量转化为功的程度。
◎ 科学技术上泛指某些物质系统状态的一种量（liàng）度，某些物质系统状态可能出现的程度。亦被社会科学用以借喻人类社会某些状态的程度。
◎ 在信息论中，熵表示的是不确定性的量度。
熵权法是一种客观赋权方法。它十分复杂，计算步骤如下：
a．构建各评价指标的判断矩阵：
b．将判断矩阵进行归一化处理, 得到归一化判断矩阵：
c．根据熵的定义，根据评价指标计算评价指标的信息熵。
d．计算系统的权重值。
详细原理可以参考知乎链接：如何用熵权法计算权重？
示例数据
演示数据量不大，读者可以直接复制为csv文件。
# dept,x1,x2,x3,x4,x5,x6,x7,x8,x9
# A,100,90,100,84,90,100,100,100,100
# B,100,100,78.6,100,90,100,100,100,100
# C,75,100,85.7,100,90,100,100,100,100
# D,100,100,78.6,100,90,100,94.4,100,100
# E,100,90,100,100,100,90,100,100,80
# F,100,100,100,100,90,100,100,85.7,100
# G,100,100,78.6,100,90,100,55.6,100,100
# H,87.5,100,85.7,100,100,100,100,100,100
# I,100,100,92.9,100,80,100,100,100,100
# J,100,90,100,100,100,100,100,100,100
# K,100,100,92.9,100,90,100,100,100,100
# 需要加载包
library(tibble)
library(dplyr)
函数准备
这里先定义需要的函数，方便后面在dplyr中使用。
## 归一化,也可以使用内置函数scale
min_max_norm <- function(x) {
(x - min(x)) / (max(x) - min(x))
}
## 计算P值
p_value <- function(x){
x / sum(x)
}
## 计算熵值
entropy <- function(x){
n <- length(x)
(-1 / log2(n)) * (sum( x * ifelse(log2(x)==-Inf, 0, log2(x)) ))
}
## 计算权重
weight <- function(x){
(1-x) / (length(x)-sum(x))
}
## 计算得分
fscore <- function(x, y){
sum(x*y)
}
R 实现熵权法
## 加载数据
dt <- read.csv("data-dp.csv")
tb.dt <- as_tibble(dt)
# A tibble: 11 x 10
# dept x1 x2 x3 x4 x5 x6 x7 x8 x9
# <chr> <dbl> <int> <dbl> <int> <int> <int> <dbl> <dbl> <int>
# 1 A 100 90 100 84 90 100 100 100 100
# 2 B 100 100 78.6 100 90 100 100 100 100
# 3 C 75 100 85.7 100 90 100 100 100 100
# 4 D 100 100 78.6 100 90 100 94.4 100 100
# 5 E 100 90 100 100 100 90 100 100 80
# 6 F 100 100 100 100 90 100 100 85.7 100
# 7 G 100 100 78.6 100 90 100 55.6 100 100
# 8 H 87.5 100 85.7 100 100 100 100 100 100
# 9 I 100 100 92.9 100 80 100 100 100 100
# 10 J 100 90 100 100 100 100 100 100 100
# 11 K 100 100 92.9 100 90 100 100 100 100
## 计算信息熵
# mutate_all 不建议使用了
# tb.dt <- tb.dt %>% select(2:10) %>%
# mutate_all(.funs = min_max_norm) %>%
# mutate_all(.funs = p_value) %>%
# summarise_all(.funs = entropy)
tb.dt <- tb.dt %>% mutate(across(c(2:10), min_max_norm)) %>%
mutate(across(c(2:10), p_value)) %>%
summarise(across(c(2:10), entropy))
tb.dt
# A tibble: 1 x 9
# x1 x2 x3 x4 x5 x6 x7 x8 x9
# <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 0.954 0.867 0.836 0.960 0.936 0.960 0.960 0.960 0.960
## 计算权重
w_dat <- tb.dt %>% weight
w_dat
# x1 x2 x3 x4 x5 x6 x7 x8 x9
# 1 0.07578559 0.2191587 0.2713738 0.06559212 0.1051977 0.06559212 0.06611572 0.06559212 0.06559212
## 计算得分
dt %>% group_by(1:n()) %>%
mutate(score = fscore(c_across(2:10), w_dat)) %>%
arrange(-score) %>%
ungroup() %>%
select("dept", "score")
# A tibble: 11 x 2
# dept score
# <chr> <dbl>
# 1 F 98.0
# 2 J 97.8
# 3 K 97.0
# 4 I 96.0
# 5 E 95.8
# 6 A 95.7
# 7 H 95.2
# 8 C 93.2
# 9 B 93.1
# 10 D 92.8
# 11 G 90.2
本文参考链接：https://blog.csdn.net/neweastsun/article/details/121632701
