Solver for the Travelling Salesman Problem.

diff --git a/elite-salesman b/elite-salesman
new file mode 100755 (executable)
index 0000000..03dd4ee
--- /dev/null
+++ b/elite-salesman
@@ -0,0 +1,135 @@
+#! /usr/bin/tclsh
+#
+# $Id: elite-salesman,v 1.1 2003/03/07 00:45:51 mdw Exp $
+
+package require "elite" "1.0.1"
+package require "vector" "1.0.0"
+package require "graph" "1.0.0"
+
+set opts {}
+set weight weight-hops
+set d 70
+set cycle 1
+for {set i 0} {$i < [llength $argv]} {incr i} {
+  set a [lindex $argv $i]
+  switch -glob -- $a {
+    "-inner" - "-dead" - "-temp" - "-cool" {
+      lappend opts $a
+      incr i
+      lappend opts [lindex $argv $i]
+    }
+    "-cycle" {
+      set cycle 1
+      lappend opts $a
+    }
+    "-nocycle" {
+      set cycle 0
+      lappend opts $a
+    }
+    "-w" {
+      incr i
+      set a [lindex $argv $i]
+      set weight "weight-$a"
+      if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
+       puts stderr "$argv0: unknown weight function `$a'"
+       puts stderr "$argv0: I know [info commands weight-*]"
+       exit 1
+      }
+    }
+    "-d" {
+      incr i
+      set d [expr {int([lindex $argv $i] * 10)}]
+    }
+    "--" {
+      incr i
+      break
+    }
+    "-*" {
+      puts stderr "unknown switch `$a'"
+      exit 1
+    }
+    default {
+      break
+    }
+  }
+}
+
+set argv [lrange $argv $i end]
+if {[llength $argv] < 1 || [llength $argv] > 2} {
+  puts stderr "usage: $argv0 \[-OPTIONS\] \[-w WEIGHT\] \[-d DIST\] GAL \[WORLD\]"
+  exit 1
+}
+
+set g [parse-galaxy-spec [lindex $argv 0]]
+if {[string equal $g ""]} {
+  puts stderr "$argv0: bad galaxy spec `$g'"
+  exit 1
+}
+destructure {ng g} $g
+set ww [elite-galaxylist $g]
+if {[llength $argv] < 2} {
+  if {!$cycle} {
+    puts stderr "$argv0: must specify starting point if not cycling"
+    exit 1
+  }
+  set p [lindex $ww 0]
+} else {
+  set p [parse-planet-spec $g [lindex $argv 1]]
+  if {[string equal $g ""]} {
+    puts stderr "$argv0: bad planet spec `$p'"
+    exit 1
+  }
+  if {![in-galaxy-p $g $p]} {
+    puts stderr "$argv0: planet `[worldname $p]' is not in galaxy $ng"
+    exit 1
+  }
+}
+
+array set index {}
+set seed {}
+set i 0
+foreach {s x y} $ww {
+  set index($s) $i
+  lappend seed $s
+  incr i
+}
+
+elite-adjacency adj $ww $d
+set av [vector {256 256} -1]
+foreach {s x y} $ww {
+  set i $index($s)
+  foreach {ss xx yy} $adj($s) {
+    set j $index($ss)
+    $av set $i $j [eval $weight [list $s $ss]]
+  }
+}
+destructure {lv pv} [graph-shortest-path $av]
+set i $index($p)
+set pp [list $i]
+for {set j 0} {$j < 256} {incr j} {
+  if {$i != $j && [$lv get $i $j] >= 0} { lappend pp $j }
+}
+puts -nonewline stderr "\[thinking..."
+destructure {dist tsp} \
+    [eval graph-travelling-salesman $opts -- [list $lv $pp]]
+puts stderr " done\]"
+puts "# Total metric = $dist"
+set home [lindex $tsp 0]
+set k $home
+puts [world-summary [lindex $seed $k] 0 2]
+foreach i [lrange $tsp 1 end] {
+  while {1} {
+    set k [$pv get $k $i]
+    if {$k < 0 || $k == $i} { break }
+    puts [world-summary [lindex $seed $k] 2 0]
+  }
+  puts [world-summary [lindex $seed $k] 0 2]
+  set k $i
+}
+if {$cycle} {
+  while {1} {
+    set k [$pv get $k $home]
+    if {$k < 0 || $k == $home} { break }
+    puts [world-summary [lindex $seed $k] 2 0]
+  }
+}