使用遗传算法的最短路径

Question

我想在 r 代码中使用遗传算法获得最短路径。我的目标类似于旅行推销员问题。我需要获得从城市 A 到 H 的最短路径。问题是，我的代码正在计算所有道路，但我只需要从城市 A 到城市 H 的最短路径（我不需要访问所有城市）。

data.frame(from = c("A", "A", "A", "B", "B", "C", "C", "D", "E", "E", "G"),

to = c("B", "C", "E", "D", "H", "D", "E", "H", "D", "G", "H"),

KM = c(78, 39, 102, 40, 118, 22, 61, 78, 54, 39, 21))

My code:
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, ...)
tspFitness

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]
}
M <- matrix(c(10000, 78, 39, 10000, 102, 10000, 10000,
              10000, 10000, 10000, 40, 10000, 10000, 118,
              10000, 10000, 10000, 22, 10000, 61, 10000,
              10000, 10000, 10000, 10000, 10000, 10000, 78,
              10000, 10000, 10000, 54, 1000, 39, 10000,
              10000, 10000, 10000, 10000, 10000, 10000, 21,
              10000, 10000, 10000, 10000, 10000, 10000, 10000), 7, byrow = TRUE)
colnames(M) <- c("AS", "AD", "AF", "AG", "AH", "AJ", "AK")
rownames(M) <- c("AS", "AD", "AF", "AG", "AH", "AJ", "AK")

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

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)])
  }
}

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,
  nBits = nrow(D_perm),
  upper = nrow(D_perm),
  mutation = mutation(nrow(D_perm), fixed_points),
  crossover = gaperm_cxCrossover,
  suggestions = feasiblePopulation(nrow(D_perm), popSize, fixed_points),
  popSize = popSize,
  maxiter = 5000,
  run = 100,
  pmutation = 0.2
)

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

solution_distance

summary(res)