R语言实战Topsis综合评价法_编程设计

本文介绍Topsis综合评价方法，通过一个实际案例说明其计算过程，并利用R语言完整过程实现。

1. Topsis方法概述

TOPSIS全称Technique for Order Preference by Similarity to an Ideal Solution ，topsis法是C.L.Hwang和K.Yoon于1981年首次提出的，它根据有限个评价对象与理想化目标的接近程度进行排序的方法，是在现有的对象中进行相对优劣的评价。作为一种逼近于理想解的排序法，该方法只要求各效用函数具有单调递增(或递减)性就行，它是多目标决策分析中一种常用的有效方法，又称为优劣解距离法。

本法的基本思想是：基于归一化后的原始数据矩阵，采用余弦法找出有限方案中的最优方案和最劣方案（分别用最优向量和最劣向量表示），然后分别计算各评价对象与最优方案和最劣方案间的距离，获得各评价对象与最优方案的相对接近程度，以此作为评价优劣的依据。

2. 示例数据

某防疫站拟对当地1997~2001年公共场所卫生监督工作质量进行评价，选择的评
价指标包含监督率%（x1）、体检率%（x2）、培训率%（x3）原始数据如下：

   year  idx1  idx2  idx3 
 1997  95    95.3  95   
 1998 100    90    90.2 
 1999  97.4  97.5  94.6 
 2000  98.4  98.2  90.3 
 2001 100    97.4  92.5

现在需对5年的公共场所卫生监督质量进行综合评价。

R实现过程

1. 加载数据及包

library(dplyr) 
library(readr) 
# load sample data 
dat <- read_csv("data/sample.csv")

2. 归一化处理

# 标准化变量值函数 
z_value <- function(x){ 
  x / sqrt(sum(x^2)) 
} 
 
# 按列对数据进行标准化 
dat_z <- dat %>% mutate(across(c(2:4), z_value)) 
 
# 返回归一化数据矩阵 
# year  idx1  idx2  idx3 
# 1997 0.433 0.445 0.459 
# 1998 0.456 0.420 0.436 
# 1999 0.444 0.455 0.457 
# 2000 0.448 0.459 0.436 
# 2001 0.456 0.455 0.447

3. 确定最优方案和最劣方案

最优方案Z + 由Z中每列中的最大值构成： Z + =(maxZ i1 ,maxZ i2 ,…,maxZ im )
最劣方案Z - 由Z中每列中的最小值构成： Z + =(minZ i1 ,minZ i2 ,…,minZ im )

## unlist 转换tibble为vector 
z_max <- dat_z %>% summarise(across(c(2:4), max)) %>% unlist 
# > z_max 
# idx1      idx2      idx3  
# 0.4555144 0.4587666 0.4590897  
 
z_min <- dat_z %>% summarise(across(c(2:4), min)) %>% unlist 
# > z_min 
# idx1      idx2      idx3  
# 0.4327386 0.4204582 0.4358936

4. 计算每一个评价对象与Z+ 和Z-的距离最优D+和最劣D-

# 计算距离 
dist <-function(x, std){ 
  res <- c() 
  for ( i in 1 : nrow(x)) { 
    res[i] = sqrt(sum((unlist(x[i,-1])-std)^2)) 
  } 
   
  return(res) 
} 
 
# 最优距离D+ 
du <- dist(dat_z, z_max) 
# 最劣距离D- 
dn <- dist(dat_z, z_min)

5. 计算各评价对象与最优方案的接近程度Ci

实现代码：

# 计算CI并按照降序排序 
dat_z %>% add_column(du = du, dn = dn) %>%  
      mutate(ci= dn/(du+dn)) %>% 
      arrange(-ci) 
 # 最终返回结果为： 
 # year  idx1  idx2  idx3     du     dn    ci 
# 1999 0.444 0.455 0.457 0.0124 0.0424 0.773 
# 2001 0.456 0.455 0.447 0.0126 0.0429 0.772 
# 2000 0.448 0.459 0.436 0.0239 0.0413 0.634 
# 1997 0.433 0.445 0.459 0.0265 0.0339 0.561 
# 1998 0.456 0.420 0.436 0.0448 0.0228 0.337

6. 完整过程

下面给出完整的代码：

library(tibble) 
library(dplyr) 
library(readr) 
 
# 标准化变量值 
z_value <- function(x){ 
  x / sqrt(sum(x^2)) 
} 
 
# 计算最优距离 
dist <-function(x, std){ 
  res <- c() 
  for ( i in 1 : nrow(x)) { 
    res[i] = sqrt(sum((unlist(x[i,-1])-std)^2)) 
  } 
   
  return(res) 
} 
 
# load sample data 
dat <- read_csv("data/sample.csv") 
 
# 按列对数据进行标准化 
dat_z <- dat %>% mutate(across(c(2:4), z_value)) 
 
## unlist 转换tibble为vector 
z_max <- dat_z %>% summarise(across(c(2:4), max)) %>% unlist 
z_min <- dat_z %>% summarise(across(c(2:4), min)) %>% unlist 
 
# dat_z %>% select(2:4) %>% rowwise() %>% mutate(du = dist(., z_max), dn= dist(., z_min))  
du <- dist(dat_z, z_max) 
dn <- dist(dat_z, z_min) 
 
# 计算CI并按照降序排序 
dat_z %>% add_column(du = du, dn = dn) %>%  
      mutate(ci= dn/(du+dn)) %>% 
      arrange(-ci)

本文参考链接：https://blog.csdn.net/neweastsun/article/details/121685849