R：定制旅行商问题

Question

我正在使用 R 编程语言。

我发现这个（非常好的）教程展示了如何在 R 中实现旅行商问题（针对一组欧洲城市）的遗传算法：https://rstudio-pubs-static.s3.amazonaws.com/132872_620c10f340f348b88453d75ec99960ff.html

library(GA)
data("eurodist", package = "datasets")
D <- as.matrix(eurodist)


tourLength <- function(tour, distMatrix) {
   tour <- c(tour, tour[1])
   route <- embed(tour, 2)[,2:1]
   sum(distMatrix[route])
}

#Firness function to be maximized

tspFitness <- function(tour, ...) 1/tourLength(tour, ...)

GA <- ga(type = "permutation", fitness = tspFitness, distMatrix = D,
          min = 1, max = attr(eurodist, "Size"), popSize = 50, maxiter = 5000,
          run = 500, pmutation = 0.2)

最后，算法 returns 您访问这些城市的顺序（按编号索引）：

    summary(GA)

## Solutions              = 
##      x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19
## [1,] 20  7 11  3  4  5 18 13 12   9  14   2  15   8  16  19   1  21  17
## [2,]  6 10 20  7 11  3  4  5 18  13  12   9  14   2  15   8  16  19   1
## [3,] 10  6 17 21  1 19 16  8 15   2  14   9  12  13  18   5   4   3  11
##      x20 x21
## [1,]   6  10
## [2,]  21  17
## [3,]   7  20

我们甚至可以看到算法返回路径的可视化：

我的问题：

是否可以通过添加一些约束来“定制”这个问题？例如，假设您绝对想在维也纳开始您的旅行 - 有没有办法告诉遗传算法开始搜索第一个城市是维也纳的最佳路径？
是否可以指示遗传算法让某些城市位于某些位置？例如，您希望第一个城市是维也纳，第六个城市是雅典 - 然后，在给定这些约束的情况下搜索最佳路径？

是否可以自定义 R 中的遗传算法以在优化旅行商问题时考虑这些“考虑因素”？

Answer 1

扩展我的评论。在处理遗传算法中的约束时，您有两个选择：

在适应度函数中加入条件
确保遗传算子创建可行的解决方案

对于第一种方法，您需要决定如何处理不可行的解决方案（例如惩罚），这完全取决于问题。如果条件难以达到，进化算法在这个过程中创建的大部分解决方案将是不可行的，并且会导致早熟收敛。

哪种适应方法取决于问题，我将向您展示如何针对此问题实施第二种方法。

矩阵变换:

transformMatrix <- function(fixed_points, D){
  
  if(length(fixed_points) == 0) return(D)
  
  p <- integer(nrow(D))
  pos <- match(names(fixed_points), colnames(D))
  p[fixed_points] <- pos 
  p[-fixed_points] <- sample(setdiff(seq_len(nrow(D)), pos))

  D[p, p]
}

此函数的目标是置换矩阵的行和列以使城市到达指定位置：

popSize <- 100
fixed_points <- c(
  "Vienna" = 1,
  "Athens" = 6
)
D_perm <- transformMatrix(fixed_points, D)

可行初始种群

feasiblePopulation <- function(n, size, fixed_points){
  
  positions <- setdiff(seq_len(n), fixed_points)
  
  m <- matrix(0, size, n)
  if(length(fixed_points) > 0){
    
    m[, fixed_points] <- rep(fixed_points, each = size)
    
    for(i in seq_len(size))
      m[i, -fixed_points] <- sample(positions)
    
  } else {
    
    for(i in seq_len(size))
      m[i,] <- sample(positions)
  }
  
  m
}

此函数创建可行的解决方案

变异

mutation <- function(n, fixed_points){
  
  positions <- setdiff(seq_len(n), fixed_points)
  
  function(obj, parent){
    
    vec <- obj@population[parent,]
    if(length(positions) < 2) return(vec) 
    
    indices <- sample(positions, 2)
    replace(vec, indices, vec[rev(indices)])
  }
}

我们需要确保变异算子保持固定位置。这个函数 returns 一个这样的变异算子。

适应度函数

fitness <- function(tour, distMatrix) {
  
  tour <- c(tour, tour[1])
  route <- embed(tour, 2)[,2:1]
  1/sum(distMatrix[route])
}

我们希望最小化距离，因此取倒数。

优化步骤

res <- ga(
  type = "permutation",
  fitness = fitness,
  distMatrix = D_perm,
  lower = 1,
  upper = nrow(D_perm),
  mutation = mutation(nrow(D_perm), fixed_points),
  crossover = gaperm_pmxCrossover,
  suggestions = feasiblePopulation(nrow(D_perm), popSize, fixed_points),
  popSize = popSize,
  maxiter = 5000,
  run = 500,
  pmutation = 0.2
)

gaperm_pmxCrossover 将确保固定位置在交叉过程中保持固定（这就是我没有编写自定义交叉运算符的原因）

解决方案

colnames(D_perm)[res@solution[1,]]
solution_distance <- 1 / fitness(res@solution[1,], D_perm)

同样第一个城市是最后一个（路线）

R：定制旅行商问题

R: Customizing the Travelling Salesman Problem

algorithm

optimization

combinations

r