【R语言】熵权法确定权重
分类:R
1. 先定义归一化函数
默认是将正向指标归一化到 [0,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)
}
测试函数:
x = c(1, 2, 3, NA, 5)
rescale(x)
rescale(x, type = "neg")
2. 定义熵权法赋权函数
因为熵权法归一化值不能出现 0
或 1
,所以在做归一化时多往内收缩一下到 [0.002, 0.996]
, 需要的话可自行修改。
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)
}
测试函数:
仍使用上一篇文章同样的数据:shang_datas.xlsx
, 为 2014 年 31 个省份的就业与劳动保障数据, 包含 5 个指标:社会养老保险参保率、医疗保险参保率、失业保险参保率、工伤保险参保率、工伤事故发生率, 其中第 5 个指标为负向指标。
library(readxl)
data = read_xlsx("datas/shang_datas.xlsx")
X = data[, 2:6]
ind = c(rep("pos",4), "neg")
Entropy_Weight(X, ind)
结果与上篇文章也完全一样。
作者 张敬信 哈尔滨工业大学 基础数学博士原文连接 【R语言】熵权法确定权重 - 知乎 (zhihu.com)