File: tsp_concorde.R

package info (click to toggle)
r-cran-tsp 1.1-6-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,128 kB
  • sloc: ansic: 277; sh: 13; makefile: 2
file content (255 lines) | stat: -rw-r--r-- 7,492 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
#######################################################################
# TSP - Traveling Salesperson Problem
# Copyrigth (C) 2011 Michael Hahsler and Kurt Hornik
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# 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.



## interface to the Concorde algorithm
## (can only handle TSP and no neg. distances!)

tsp_concorde <- function(x, control = NULL){

  if(!is.null(control$exe)) warning("exe is deprecated. Use concorde_path() instead!")

  ## get parameters
  control <- .get_parameters(control, list(
    clo = "",
    precision = 6,
    exe = .find_exe(control$exe, "concorde"),
    verbose = TRUE
  ))

  precision <- control$precision

  ## check x
  if(inherits(x, "TSP")){

    ## fix neg. values
    min_x <- min(x)
    if(min_x<0) x <- x - min_x

    ## get max (excluding) to check for possible integer overflows
    max_x <- max(x)
    if(n_of_cities(x) < 10){
      ## <10 cities: concorde can only handle max 2^15
      MAX <- 2^15
      if(max_x > MAX) stop("Concorde can only handle distances < 2^15 for less than 10 cities")

      prec <- floor(log10(MAX / max_x))
      if(prec < precision) {
        precision <- prec
        if(control$verbose)
          warning(paste("Concorde can only handle distances < 2^15 for",
            "less than 10 cities. Reducing precision to",
            precision), immediate. = TRUE)
      }
    }else{
      ## regular constraint on integer is 2^31 - 1
      MAX <- 2^31 - 1

      prec <- floor(log10(MAX / max_x / n_of_cities(x)))
      if(prec < precision) {
        precision <- prec
        if(control$verbose)
          warning(paste("Concorde can only handle distances < 2^31.",
            "Reducing precision for Concorde to", precision), immediate. = TRUE)
      }
    }
  }else if(inherits(x, "ETSP")) {
    ## nothing to do!
  }else stop("Concorde only handles TSP and ETSP.")


  ## get temp files and change working directory
  wd <- tempdir()
  dir <- getwd()
  setwd(wd)
  on.exit(setwd(dir))

  ### fix for Windows by Stephen Eick
  ##temp_file <- tempfile(tmpdir = wd)
  temp_file <- basename(tempfile(tmpdir = wd))

  ## file name needs to be unique
  tmp_file_in  <- paste(temp_file, ".dat", sep = "")
  tmp_file_out <- paste(temp_file, ".sol", sep = "")

  write_TSPLIB(x, file = tmp_file_in,
    precision = precision)

  ## change working directory

  ## do the call and read back result
  ## we do not check return values of concorde since they are not
  ## very consistent
  system2(control$exe,
    args =  paste("-x", control$clo, "-o", tmp_file_out, tmp_file_in),
    stdout = if(control$verbose) "" else FALSE,
    stderr = if(control$verbose) "" else FALSE,
    )


  if(!file.access(tmp_file_out) == 0)
    stop("Problems with reading Concorde's output.\nIs concorde properly installed?\nFor details see ? Concorde")
  ##else cat("Concorde done.\n")

  order <- scan(tmp_file_out, what = integer(0), quiet = TRUE)
  ## remove number of nodes and add one (result starts with 0)
  order <- order[-1] + 1L

  ## tidy up
  unlink(c(tmp_file_in, tmp_file_out))

  order
}

## interface to the Concorde's Chained Lin-Kernighan algorithm
## (can only handle TSP, handles neg. distances)

tsp_linkern <- function(x, control = NULL){

  if(!is.null(control$exe))
    warning("exe is deprecated. Use concorde_path() instead!")

  ## get parameters
  control <- .get_parameters(control, list(
    exe = .find_exe(control$exe, "linkern"),
    clo = "",
    precision = 6,
    verbose = TRUE
  ))

  precision <- control$precision

  ## have to set -r for small instances <8
  if(n_of_cities(x) <=8)
    control$clo <- paste(control$clo, "-k", n_of_cities(x))

  ## check x
  if(inherits(x, "TSP")) {
    ## check for possible overflows
    max_x <- max(abs(x[is.finite(x)]))
    MAX <- 2^31 - 1

    prec <- floor(log10(MAX / max_x / n_of_cities(x)))
    if(prec < precision) {
      precision <- prec
      if(control$verbose)
        warning(paste("Linken can only handle distances < 2^31.",
          "Reducing precision to", precision), immediate. = TRUE)
    }
  }else if(inherits(x, "ETSP")) {
    ## nothing to do
  } else stop("Linkern only works for TSP and ETSP.")

  ## get temp files
  wd <- tempdir()
  temp_file <- tempfile(tmpdir = wd)

  ## file name needs to be unique
  tmp_file_in  <- paste(temp_file, ".dat", sep = "")
  tmp_file_out <- paste(temp_file, ".sol", sep = "")

  ## prepare data (neg_inf = 0 so everything is > 0)
  write_TSPLIB(x, file = tmp_file_in,
    precision = precision)

  ## change working directory
  dir <- getwd()
  setwd(wd)
  on.exit(setwd(dir))

  ## do the call and read back result
  ## we do not check return values of concorde since they are not
  ## very consistent
  system2(control$exe, args =  paste("-o",
    tmp_file_out, control$clo, tmp_file_in),
    stdout = if(control$verbose) "" else FALSE,
    stderr = if(control$verbose) "" else FALSE)

  if(!file.access(tmp_file_out) == 0)
    stop("Problems with reading linkern's output. Is linkern properly installed?")
  ##else cat("Concorde done.\n")

  order <- read.table(tmp_file_out)[,1]
  ## remove number of nodes and add one (result starts with 0)
  order <- order + as.integer(1)

  ## tidy up
  unlink(c(tmp_file_in, tmp_file_out))

  order
}


## get help page
concorde_help <- function() {
  cat("The following options can be specified in solve_TSP with method \"concorde\" using clo in control:\n\n")
  system2(.find_exe(NULL, "concorde"), args = "")
}

linkern_help <- function() {
  cat("The following options can be specified in solve_TSP with method \"linkern\" using clo in control:\n\n")
  system2(.find_exe(NULL, "linkern"), args = "")
}

## path
concorde_path <- local({
  .path <- NULL
  function(path){
    if(missing(path)) {
      if(!is.null(.path)) return(.path)
      else {
        ## find concorde and/or linkern
        p <- dirname(Sys.which("concorde"))
        if(p == "") p <- dirname(Sys.which("linkern"))
        if(p == "") stop("Can not find executables for concorde or linkern. Please install the executables or set path manually.")
        return(p)
      }
    } else {
      if(!is.null(path)) {
        ex <- c(list.files(path, pattern = "concorde",
          ignore.case = TRUE),
          list.files(path, pattern = "linkern",
            ignore.case = TRUE))
        if(length(ex) < 1)
          stop(paste("no executable (concorde and/or linkern) found in",
            path))
        cat("found:", ex, "\n")
      }
      .path <<- path

      invisible(.path)

    }
  }
})


## helper to find the concorde executable
.find_exe <- function(exe = NULL, prog) {
  ## if not specified
  if(is.null(exe)) {
    ## was the path set ?
    if(!is.null(concorde_path()))
      exe <- paste(concorde_path(), .Platform$file.sep, prog, sep ="")
    ## no, so it must be in the systems execution path
    else exe <- prog
  }
  exe
}