This work is licensed under the Creative Commons Attribution 4.0 International License. For questions please contact Michael Hahsler.
This example shows how to solve a Traveling Salesman Problem (TSP).
library("Rglpk")
## Loading required package: slam
## Using the GLPK callable library version 4.57
library("seriation") # for pimage
library("TSP") # for TSP support
The program with the data can be found here tsp.mod
x <- Rglpk_read_file("tsp.mod", type = "MathProg")
x
## A mixed integer linear program with 480 objective variables,
## 240 are integer and 240 of which are binary variables.
## This problem has 288 constraints with 1440 non-zero values in the constraint matrix.
str(x)
## List of 5
## $ objective :List of 6
## ..$ i : int [1:240] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ j : int [1:240] 1 1 1 1 1 1 1 1 1 1 ...
## ..$ v : num [1:240] 509 501 312 1019 736 ...
## ..$ nrow : int 480
## ..$ ncol : int 1
## ..$ dimnames: NULL
## ..- attr(*, "class")= chr "simple_triplet_matrix"
## $ constraints:List of 3
## ..$ :List of 6
## .. ..$ i : int [1:1440] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..$ j : int [1:1440] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ v : num [1:1440] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..$ nrow : int 288
## .. ..$ ncol : int 480
## .. ..$ dimnames: NULL
## .. ..- attr(*, "class")= chr "simple_triplet_matrix"
## ..$ : chr [1:288] "==" "==" "==" "==" ...
## ..$ : num [1:288] 1 1 1 1 1 1 1 1 1 1 ...
## $ bounds :List of 2
## ..$ lower:List of 2
## .. ..$ ind: int [1:480] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ val: num [1:480] 0 0 0 0 0 0 0 0 0 0 ...
## ..$ upper:List of 2
## .. ..$ ind: int [1:480] 1 2 3 4 5 6 7 8 9 10 ...
## .. ..$ val: num [1:480] 1 1 1 1 1 1 1 1 1 1 ...
## $ types : chr [1:480] "B" "B" "B" "B" ...
## $ maximum : logi FALSE
## - attr(*, "class")= chr [1:2] "MP_data_from_file" "MILP"
## - attr(*, "n_objective_vars")= int 480
## - attr(*, "n_integer_vars")= int 240
## - attr(*, "n_binary_vars")= int 240
## - attr(*, "n_constraints")= int 288
## - attr(*, "n_nonzeros")= int 1440
## - attr(*, "problem_name")= chr "tsp"
## - attr(*, "objective_name")= chr "total"
## - attr(*, "objective_vars_names")= chr [1:480] "x[1,2]" "x[1,3]" "x[1,4]" "x[1,5]" ...
## - attr(*, "constraint_names")= chr [1:288] "leave[1]" "leave[2]" "leave[3]" "leave[4]" ...
## - attr(*, "file_type")= chr "MathProg"
## - attr(*, "file_name")= chr "/home/hahsler/hahsler_net/public_html/michael/SMU/EMIS7332/R/optimization/tsp.mod"
The program contained the distance data in $objective
in the same order as the decision variables x
.
ns <- attr(x, "objective_vars_names")
ns <- do.call("rbind", strsplit(ns, "\\[|\\]|,"))
take <- ns[,1]=="x"
ns <- ns[take, 2:3]
mode(ns) <- "integer"
n <- max(ns)
d <- matrix(0L, nrow = n, ncol = n)
for(i in 1:nrow(ns)) d[ns[i,1], ns[i,2]] <- x$objective$v[i]
isSymmetric(d)
## [1] TRUE
d <- as.dist(d)
d
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14
## 2 509
## 3 501 126
## 4 312 474 541
## 5 1019 1526 1516 1157
## 6 736 1226 1184 980 478
## 7 656 1133 1084 919 583 115
## 8 60 532 536 271 996 740 667
## 9 1039 1449 1371 1333 858 470 455 1066
## 10 726 1122 1045 1029 855 379 288 759 328
## 11 2314 2789 2728 2553 1504 1581 1661 2320 1387 1697
## 12 479 958 913 751 677 271 177 493 591 333 1838
## 13 448 941 904 704 651 289 216 454 650 400 1868 68
## 14 479 978 946 720 600 261 207 479 656 427 1841 105 52
## 15 619 1127 1115 783 401 308 343 598 776 622 1789 336 287 237
## 16 150 542 499 455 1033 687 592 206 933 610 2248 417 406 449
## 15
## 2
## 3
## 4
## 5
## 6
## 7
## 8
## 9
## 10
## 11
## 12
## 13
## 14
## 15
## 16 636
pimage(d)
The distances in the example are calculated from 2d data using Euclidean distance, so we can reconstruct the relative city positions using MDS.
p <- cmdscale(d)
plot(p)
res <- Rglpk_solve_LP(x$objective, x$constraints[[1]], x$constraints[[2]],
x$constraints[[3]], x$bounds, x$types, x$maximum)
res
## $optimum
## [1] 6859
##
## $solution
## [1] 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0
## [24] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0
## [47] 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [70] 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0
## [93] 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0
## [116] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
## [139] 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0
## [162] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0
## [185] 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 0
## [208] 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [231] 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 15 0 0 0 0 0 0
## [254] 0 0 0 12 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [277] 0 0 0 0 0 0 0 0 11 0 13 0 0 0 0 0 0 0 0 0 0 0 0
## [300] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6 0 0 0 0 0 0 4 0
## [323] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3 0 0 0 0
## [346] 0 0 0 14 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [369] 0 8 0 0 0 0 0 0 0 0 0 0 0 0 0 9 0 0 0 0 0 0 0
## [392] 0 0 0 7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [415] 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0
## [438] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 0 0 0 0
## [461] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 10 0 0 0 0 0
##
## $status
## [1] 0
##
## $solution_dual
## [1] NA
##
## $auxiliary
## $auxiliary$primal
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [18] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0
## [35] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -3 0 0
## [52] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [69] 0 0 0 0 0 0 0 0 -4 0 -2 0 0 0 0 0 0
## [86] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [103] 0 0 0 -9 0 0 0 0 0 0 -11 0 0 0 0 0 0
## [120] 0 0 0 0 0 0 0 0 0 0 0 0 0 -12 0 0 0
## [137] 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0
## [154] 0 0 0 0 0 0 0 0 -7 0 0 0 0 0 0 0 0
## [171] 0 0 0 0 0 -6 0 0 0 0 0 0 0 0 0 0 -8
## [188] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [205] 0 0 0 0 -13 0 0 0 0 0 0 0 0 0 0 0 0
## [222] 0 0 0 -14 0 0 -15 0 0 0 0 0 0 0 0 0 0
## [239] 0 0 0 0 0 0 0 0 0 -10 0 0 0 0 0 0 0
## [256] 0 0 0 0 0 0 0 0 0 0 0 -5 0 0 0 0 0
## [273] -15 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##
## $auxiliary$dual
## [1] NA
We need to match the decision variables back to a tour. We can use ns
from before to convert the solution into an adjacency matrix. We only need the solution for the xs and not the ys.
rs <- res$solution[take]
m <- matrix(0, nrow = n, ncol = n)
for(i in 1:nrow(ns)) m[ns[i,1], ns[i,2]] <- rs[i]
pimage(m)
convert matrix into a tour
o <- integer(n)
o[1] <- 1L
for(i in 2:n) o[i] <- which(m[o[i-1],] >0)
o
## [1] 1 8 4 2 3 16 10 9 11 5 15 6 7 12 13 14
calculate tour length, look at the reordered distance matrix and the tour.
tour_length(TSP(d), o)
## [1] 6859
pimage(d, o)
plot(ETSP(p), o)
compare solution with a heuristic
o2 <- solve_TSP(TSP(d))
o2
## object of class 'TOUR'
## result of method 'arbitrary_insertion+two_opt' for 16 cities
## tour length: 6941
plot(ETSP(p), o2)