3 # $Id: elite-salesman,v 1.2 2003/03/10 23:37:49 mdw Exp $
5 package require "elite" "1.0.1"
6 package require "vector" "1.0.0"
7 package require "graph" "1.0.0"
10 set weight weight-hops
13 for {set i 0} {$i < [llength $argv]} {incr i} {
14 set a [lindex $argv $i]
16 "-inner" - "-dead" - "-temp" - "-cool" {
19 lappend opts [lindex $argv $i]
31 set a [lindex $argv $i]
32 set weight "weight-$a"
33 if {[lsearch -exact [info commands "weight-*"] $weight] == -1} {
34 puts stderr "$argv0: unknown weight function `$a'"
35 puts stderr "$argv0: I know [info commands weight-*]"
41 set d [expr {int([lindex $argv $i] * 10)}]
48 puts stderr "unknown switch `$a'"
57 set argv [lrange $argv $i end]
58 if {[llength $argv] < 1 || [llength $argv] > 2} {
59 puts stderr "usage: $argv0 \[-OPTIONS\] \[-w WEIGHT\] \[-d DIST\] GAL \[WORLD\]"
63 set g [parse-galaxy-spec [lindex $argv 0]]
64 if {[string equal $g ""]} {
65 puts stderr "$argv0: bad galaxy spec `$g'"
69 set ww [elite-galaxylist $g]
70 if {[llength $argv] < 2} {
72 puts stderr "$argv0: must specify starting point if not cycling"
77 set p [parse-planet-spec $g [lindex $argv 1]]
78 if {[string equal $p ""]} {
79 puts stderr "$argv0: bad planet spec `[lindex $argv 1]'"
82 if {![in-galaxy-p $g $p]} {
83 puts stderr "$argv0: planet `[worldname $p]' is not in galaxy $ng"
97 elite-adjacency adj $ww $d
98 set av [vector {256 256} -1]
101 foreach {ss xx yy} $adj($s) {
103 $av set $i $j [eval $weight [list $s $ss]]
107 destructure {lv pv} [graph-shortest-path $av]
110 for {set j 0} {$j < 256} {incr j} {
111 if {$i != $j && [$lv get $i $j] >= 0} { lappend pp $j }
113 puts -nonewline stderr "\[thinking..."
114 destructure {dist tsp} \
115 [eval graph-travelling-salesman $opts -- [list $lv $pp]]
116 puts stderr " done\]"
117 puts "# Total metric = $dist"
118 set home [lindex $tsp 0]
120 puts [world-summary [lindex $seed $k] 0 2]
121 foreach i [lrange $tsp 1 end] {
123 set k [$pv get $k $i]
124 if {$k < 0 || $k == $i} { break }
125 puts [world-summary [lindex $seed $k] 2 0]
127 puts [world-summary [lindex $seed $k] 0 2]
132 set k [$pv get $k $home]
133 if {$k < 0 || $k == $home} { break }
134 puts [world-summary [lindex $seed $k] 2 0]