Skip to main content
 首页 » 编程设计

R语言实现熵权法计算权重

2022年07月19日134mq0036

按照信息论基本原理的解释,信息是系统有序程度的一个度量,熵是系统无序程度的一个度量;根据信息熵的定义,对于某项指标,可以用熵值来判断某个指标的离散程度,其信息熵值越小,指标的离散程度越大,该指标对综合评价的影响(即权重)就越大,如果某项指标的值全部相等,则该指标在综合评价中不起作用。因此,可利用信息熵这个工具,计算出各个指标的权重,为多指标综合评价提供依据。

熵权法

物理学上指热能除以温度所得的商,标志热量转化为功的程度。
◎ 科学技术上泛指某些物质系统状态的一种量(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
阅读延展