放假大家都有出去玩嗎?
今天到高雄看看可愛小動物看煙火...
娛樂的下場就是寫不完文章啦

今天延續昨天的例子繼續

有在一些小地方做了修正
(重複的地方還請大家多多見諒)

路徑成本

# fitness vector
A<-c(0,25,25,10,35)
B<-c(25,0,25,35,25)
C<-c(25,25,0,30,15)
D<-c(10,35,30,0,20)
E<-c(35,25,15,20,0)
city<-rbind(A,B,C,D,E)
colnames(city)<-c('A','B','C','D','E')
city<-as.matrix(city)

適應函數

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

監控函數

查看每一代演變的過程

#monitor
monitor<-function(obj){
  len<-tourLength(obj@population[1:5,])
  pop<-obj@population[1:5,]
  print(cbind(pop, len))
}

執行基因演算法

GA.fit <- ga(type = "permutation", 
             fitness = tspfitness, 
             distMatrix = as.matrix(city), 
             lower = 1, 
             upper = 5,
             popSize = 10, 
             maxiter = 500, 
             run = 100, 
             pmutation = 0.2, 
             monitor = NULL)

繪製結果

這邊的程式碼會跟參考資料相同

getAdj <- function(tour) {
  n <- length(tour)
  from <- tour[1:(n - 1)]
  to <- tour[2:n]
  m <- n - 1
  A <- matrix(0, m, m)
  A[cbind(from, to)] <- 1
  A <- A + t(A)
  return(A)
}

# 2-d coordinates
mds <- cmdscale(city)
x <- mds[, 1]
y <- -mds[, 2]
n <- length(x)

B <- 100
fitnessMat <- matrix(0, B, 2)
A <- matrix(0, n, n)
for (b in seq(1, B)) {
  # run a GA algorithm
  GA.rep <- ga(type = "permutation", 
               fitness = tspfitness, 
               distMatrix = as.matrix(city), 
               lower = 1, 
               upper = 5,
               popSize = 10, 
               maxiter = 50, 
               run = 100, 
               pmutation = 0.2, 
               monitor = NULL)

  tour <- GA.rep@solution[1, ]
  tour <- c(tour, tour[1])
  #fitnessMat[b, 1] <- GA.rep@bestSol[GA.rep@iter]
  #fitnessMat[b, 2] <- GA.rep@mean[GA.rep@iter]
  A <- A + getAdj(tour)
}

plot.tour <- function(x, y, A) {
  n <- nrow(A)
  for (ii in seq(2, n)) {
    for (jj in seq(1, ii)) {
      w <- A[ii, jj]
      if (w > 0) 
        lines(x[c(ii, jj)], y[c(ii, jj)], lwd = w, col = "lightgray")
    }
  }
}


plot(x, y, type = "n", asp = 1, xlab = "", ylab = "", main = "Tour after GA converged")
points(x, y, pch = 16, cex = 1.5, col = "grey")
abline(h = pretty(range(x), 10), v = pretty(range(y), 10), col = "lightgrey")
tour <- GA.fit@solution[1, ]
tour <- c(tour, tour[1])
n <- length(tour)
arrows(x[tour[-n]], y[tour[-n]], x[tour[-1]], y[tour[-1]], length = 0.15, angle = 45, 
       col = "steelblue", lwd = 2)
text(x, y - 100, labels(city)[[1]], cex = 0.8)

結果

今天的程式碼可能要晚點才能上傳了
電腦陷入了更新的循環中...
更新好會再補上link

相關資料參考：
R Documentation-GA
GA包--遗传算法
RPubs - Optimized Delivery Route using Genetic Algorithm: Cost cutting for e-commerce
RPubs - Genetic Algorithm on TSP