从0开始学习R语言--Day33-熵值灰度关联

原创于 2025-06-29 00:56:41 发布 · 154 阅读

CC 4.0 BY-SA版权

文章标签：

在涉及到需要对数据进行评估时（药物的效果，手机零件的价格和尺寸，在长达10年的发展中每年的纯利润），单单对不同指标去拟合看起来是一件非常困难的事情，因为需要定义不同指标的权重，这是未知量，而要评估结果的好坏又需要定指标的权重。

熵值灰度关联法，采用了一种假设的方式来定义权重，即假设出有一个完美的结果，将指标去做对比，起伏大的，就认为是其对结果有较大影响，给予大的权重，反过来则给小的权重。就好比不同手机的价格与好坏，摄像头的尺寸都大差不差，但其运行内存和GPU却有很大区别，这就意味着摄像头的权重较小，运行内存和GPU的权重较大。

以下是一个例子：

library(dplyr)
library(ggplot2)

# 1. 生成示例数据集（5个评价对象，4个评价指标）
set.seed(123)
data <- data.frame(
  方案 = paste0("方案", 1:5),
  指标1 = c(8.1, 7.8, 8.5, 7.3, 8.0),
  指标2 = c(250, 280, 200, 300, 230),
  指标3 = c(15, 12, 18, 10, 16),
  指标4 = c(0.85, 0.90, 0.82, 0.92, 0.88)
)

print("原始数据集：")
print(data)

# 2. 数据标准化处理（效益型指标和成本型指标）
# 假设指标1、4是效益型（越大越好），指标2、3是成本型（越小越好）
normalize <- function(x, type = "benefit") {
  if (type == "benefit") {
    (x - min(x)) / (max(x) - min(x))
  } else {
    (max(x) - x) / (max(x) - min(x))
  }
}

data_norm <- data %>%
  mutate(
    指标1 = normalize(指标1, "benefit"),
    指标2 = normalize(指标2, "cost"),
    指标3 = normalize(指标3, "cost"),
    指标4 = normalize(指标4, "benefit")
  )

print("标准化后的数据：")
print(data_norm)

# 3. 熵值法计算权重
calculate_entropy_weight <- function(data) {
  # 去除非数值列
  df <- data[, sapply(data, is.numeric)]
  
  # 计算第j项指标下第i个方案的特征比重
  p <- df / colSums(df)[col(df)]
  
  # 计算第j项指标的熵值
  k <- 1 / log(nrow(df))
  e <- -k * colSums(p * log(p), na.rm = TRUE)
  
  # 计算权重
  w <- (1 - e) / sum(1 - e)
  
  return(w)
}

weights <- calculate_entropy_weight(data_norm[, -1])
print("各指标权重：")
print(weights)

# 4. 灰色关联分析
calculate_grey_relation <- function(data, weights) {
  df <- data[, sapply(data, is.numeric)]
  
  # 确定参考序列（各指标最大值）
  reference <- apply(df, 2, max)
  
  # 计算关联系数
  rho <- 0.5  # 分辨系数
  delta <- abs(t(t(df) - reference))
  min_delta <- min(delta)
  max_delta <- max(delta)
  
  relation_coef <- (min_delta + rho * max_delta) / (delta + rho * max_delta)
  
  # 计算加权关联度
  grey_relation <- rowMeans(relation_coef %*% diag(weights))
  
  return(grey_relation)
}

grey_result <- calculate_grey_relation(data_norm, weights)
result <- data.frame(方案 = data$方案, 关联度 = grey_result) %>%
  arrange(desc(关联度))

print("最终评价结果（按关联度排序）：")
print(result)

# 5. 可视化结果
ggplot(result, aes(x = reorder(方案, 关联度), y = 关联度, fill = 关联度)) +
  geom_bar(stat = "identity") +
  scale_fill_gradient(low = "lightblue", high = "darkblue") +
  labs(title = "各方案灰色关联度评价结果",
       x = "方案",
       y = "灰色关联度") +
  theme_minimal() +
  coord_flip()

输出：

    指标1     指标2     指标3     指标4 
0.2130029 0.2746413 0.2757249 0.2366310 
   方案    关联度
1 方案4 0.1687260
2 方案3 0.1646074
3 方案2 0.1391947
4 方案5 0.1323964
5 方案1 0.1215657