按照信息論基本原理的解釋，信息是系統有序程度的一個度量，熵是系統無序程度的一個度量；根據信息熵的定義，對于某項指標，可以用熵值來判斷某個指標的離散程度，其信息熵值越小，指標的離散程度越大，該指標對綜合評價的影響（即權重）就越大，如果某項指標的值全部相等，則該指標在綜合評價中不起作用。因此，可利用信息熵這個工具，計算出各個指標的權重，為多指標綜合評價提供依據。

熵權法

物理學上指熱能除以溫度所得的商，標志熱量轉化為功的程度。
◎ 科學技術上泛指某些物質系統狀態的一種量（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

總結

以上是生活随笔為你收集整理的R 实现熵权法计算权重的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。