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

#### Documented in tour_lengthtour_length.ATSPtour_length.ETSPtour_length.integertour_length.TOURtour_length.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.

#' Calculate the length of a tour
#'
#' Calculate the length of a [TOUR] for a [TSP].
#'
#' If no `tsp` is specified, then the tour length stored in `x` as
#' attribute `"tour_length"` is returned.  If `tsp` is given then the
#' tour length is recalculated using the specified TSP problem.
#'
#' If a distance in the tour is infinite, the result is also infinite. If the
#' tour contains positive and negative infinite distances then the method
#' returns `NA`.
#'
#' @family TOUR
#'
#' @param x a TSP problem or a [TOUR].
#' @param order an object of class `TOUR`
#' @param tsp as TSP object.
#' @param ... further arguments are currently unused.
#' @author Michael Hahsler
#' @keywords optimize
#' @examples
#'
#' data("USCA50")
#'
#' ## original order
#' tour_length(solve_TSP(USCA50, method="identity"))
#'
#' ## length of a manually created (random) tour
#' tour <- TOUR(sample(seq(n_of_cities(USCA50))))
#' tour
#' tour_length(tour)
#' tour_length(tour, USCA50)
#' @export
tour_length <- function(x, ...)
UseMethod("tour_length")

#' @rdname tour_length
#' @export
tour_length.TSP <- function(x, order, ...) {
n <- n_of_cities(x)
if (missing(order))
order <- 1:n

.Call(R_tour_length_dist, x, order)
}

#' @rdname tour_length
#' @export
tour_length.ATSP <- function(x, order, ...) {
n <- n_of_cities(x)
if (missing(order))
order <- 1:n

.Call(R_tour_length_matrix, x, order)
}

### faster for small n but takes O(n^2) memory
#tour_length.ETSP <- function(x, order) tour_length(as.TSP(x), order)

#' @rdname tour_length
#' @export
tour_length.ETSP <- function(x, order, ...) {
n <- n_of_cities(x)
if (n != nrow(x))
stop("x and order do not have the same number of cities!")

if (missing(order))
order <- 1:n

as.numeric(sum(sapply(
1:(n - 1),
FUN = function(i)
dist(x[order[c(i, i + 1)], , drop = FALSE])
)) +
dist(x[order[c(n, 1)], , drop = FALSE]))
}

#' @rdname tour_length
#' @export
tour_length.TOUR <- function(x, tsp = NULL, ...) {
if (is.null(tsp)) {
len <- attr(x, "tour_length")
if (is.null(len))
len <- NA
return(len)
}

tour_length(x = tsp, order = x)
}

#' @rdname tour_length
#' @export
tour_length.integer <- function(x, tsp = NULL, ...) {
if (is.null(tsp))
return(NA)

tour_length(x = tsp, order = x)
}
```

## Try the TSP package in your browser

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

TSP documentation built on April 4, 2023, 5:13 p.m.