# R/solve_TSP.R In TSP: Traveling Salesperson Problem (TSP)

#### Documented in solve_TSPsolve_TSP.ATSPsolve_TSP.TSP

```#######################################################################
# TSP - Traveling Salesperson Problem
# Copyrigth (C) 2011 Michael Hahsler and Kurt Hornik
#
# This program is free software; you can redistribute it and/or modify
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

## generic
solve_TSP <- function(x, method = NULL, control = NULL, ...)
UseMethod("solve_TSP")

## TSP
solve_TSP.TSP <- function(x, method = NULL, control = NULL, ...) {
.solve_TSP(x, method, control, ...)
}

## ATSP
solve_TSP.ATSP <- function(x, method = NULL, control = NULL, ...) {
.solve_TSP(x, method, control, ...)
}

## ETSP
solve_TSP.ETSP <- function(x, method = NULL, control = NULL, ...) {

## all but concorde and linkern can only do TSP
if(length(m) == 0L || is.na(m)) x <- as.TSP(x)

.solve_TSP(x, method, control, ...)
}

## Deal with Inf: punish (-)Inf with max (min) +(-) 2*range
.replaceInf <- function(x, pInf = NULL, nInf = NULL) {
if(any(is.infinite(x))) {
range_x <- range(x, na.rm = TRUE, finite = TRUE)
if(is.null(pInf)) pInf <- range_x[2] + 2* diff(range_x)
if(is.null(nInf)) nInf <- range_x[1] - 2* diff(range_x)
x[x == Inf] <- pInf
x[x == -Inf] <- nInf
}
x
}

## workhorse
.solve_TSP <- function(x, method = NULL, control = NULL, ...) {

control <- c(control, list(...))

## methods
methods <- c(
"identity",
"random",
"nearest_insertion",
"farthest_insertion",
"cheapest_insertion",
"arbitrary_insertion",
"nn",
"repetitive_nn",
"2-opt", ### deprecated
"two_opt",
"concorde",
)

## default is arbitrary_insertion + two_opt
if(is.null(method)) {
method <- "arbitrary_insertion"
if(is.null(control\$two_opt))
control <- c(control, list(two_opt = TRUE))
} else method <- match.arg(tolower(method), methods)

## check for NAs
if(any(is.na(x))) stop("NAs not allowed!")

## Inf
x_ <- .replaceInf(x)

## work horses
.solve_TSP_worker <- function(x_, method, control) {
order <- switch(method,
identity = seq(n_of_cities(x_)),
random = sample(n_of_cities(x_)),
nearest_insertion = tsp_insertion(x_, type = "nearest", control = control),
farthest_insertion = tsp_insertion(x_, type = "farthest", control = control),
cheapest_insertion = tsp_insertion(x_, type = "cheapest", control = control),
#      arbitrary_insertion = tsp_insertion(x_, type = "arbitrary", control = control),
arbitrary_insertion = tsp_insertion_arbitrary(x_, control = control),
nn = tsp_nn(x_, control = control),
repetitive_nn = tsp_repetitive_nn(x_, control = control),
two_opt = tsp_two_opt(x_, control = control),
'2-opt' = tsp_two_opt(x_, control = control),
concorde = tsp_concorde(x_, control = control),
)

### do refinement two_opt
if(!is.null(control\$two_opt) && control\$two_opt) {
order <- tsp_two_opt(x_, control = c(control, list(tour = order)))
method <- paste(method , "+two_opt", sep = "")
}

TOUR(order, method=method, tsp=x)
}

## do rep?
if(!is.null(control\$rep)) n <- control\$rep
else n <- 1L

if(method == "concorde" || method == "linkern") {
n <- 1L
control\$two_opt <- NULL ## no two_opt for these!
}
if(method == "repetitive_nn") n <- 1L

if(n==1L) return(.solve_TSP_worker(x_, method, control))

#l <- replicate(n, .solve_TSP_worker(x_, method, control), simplify = FALSE)
l <- foreach(i = 1:n) %dopar% .solve_TSP_worker(x_, method, control)

l <- l[[which.min(sapply(l, attr, "tour_length"))]]
attr(l, "method") <- paste(attr(l, "method"), "_rep_", n, sep="")
return(l)
}
```

## Try the TSP package in your browser

Any scripts or data that you put into this service are public.

TSP documentation built on April 30, 2018, 5:03 p.m.