R语言计算优势种 r语言优化算法

本文介绍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)