| 1 | #! /usr/bin/tclsh |
| 2 | # |
| 3 | # $Id: elite-salesman,v 1.2 2003/03/10 23:37:49 mdw Exp $ |
| 4 | |
| 5 | package require "elite" "1.0.1" |
| 6 | package require "vector" "1.0.0" |
| 7 | package require "graph" "1.0.0" |
| 8 | |
| 9 | set opts {} |
| 10 | set weight weight-hops |
| 11 | set d 70 |
| 12 | set cycle 1 |
| 13 | for {set i 0} {$i < [llength $argv]} {incr i} { |
| 14 | set a [lindex $argv $i] |
| 15 | switch -glob -- $a { |
| 16 | "-inner" - "-dead" - "-temp" - "-cool" { |
| 17 | lappend opts $a |
| 18 | incr i |
| 19 | lappend opts [lindex $argv $i] |
| 20 | } |
| 21 | "-cycle" { |
| 22 | set cycle 1 |
| 23 | lappend opts $a |
| 24 | } |
| 25 | "-nocycle" { |
| 26 | set cycle 0 |
| 27 | lappend opts $a |
| 28 | } |
| 29 | "-w" { |
| 30 | incr 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-*]" |
| 36 | exit 1 |
| 37 | } |
| 38 | } |
| 39 | "-d" { |
| 40 | incr i |
| 41 | set d [expr {int([lindex $argv $i] * 10)}] |
| 42 | } |
| 43 | "--" { |
| 44 | incr i |
| 45 | break |
| 46 | } |
| 47 | "-*" { |
| 48 | puts stderr "unknown switch `$a'" |
| 49 | exit 1 |
| 50 | } |
| 51 | default { |
| 52 | break |
| 53 | } |
| 54 | } |
| 55 | } |
| 56 | |
| 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\]" |
| 60 | exit 1 |
| 61 | } |
| 62 | |
| 63 | set g [parse-galaxy-spec [lindex $argv 0]] |
| 64 | if {[string equal $g ""]} { |
| 65 | puts stderr "$argv0: bad galaxy spec `$g'" |
| 66 | exit 1 |
| 67 | } |
| 68 | destructure {ng g} $g |
| 69 | set ww [elite-galaxylist $g] |
| 70 | if {[llength $argv] < 2} { |
| 71 | if {!$cycle} { |
| 72 | puts stderr "$argv0: must specify starting point if not cycling" |
| 73 | exit 1 |
| 74 | } |
| 75 | set p [lindex $ww 0] |
| 76 | } else { |
| 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]'" |
| 80 | exit 1 |
| 81 | } |
| 82 | if {![in-galaxy-p $g $p]} { |
| 83 | puts stderr "$argv0: planet `[worldname $p]' is not in galaxy $ng" |
| 84 | exit 1 |
| 85 | } |
| 86 | } |
| 87 | |
| 88 | array set index {} |
| 89 | set seed {} |
| 90 | set i 0 |
| 91 | foreach {s x y} $ww { |
| 92 | set index($s) $i |
| 93 | lappend seed $s |
| 94 | incr i |
| 95 | } |
| 96 | |
| 97 | elite-adjacency adj $ww $d |
| 98 | set av [vector {256 256} -1] |
| 99 | foreach {s x y} $ww { |
| 100 | set i $index($s) |
| 101 | foreach {ss xx yy} $adj($s) { |
| 102 | set j $index($ss) |
| 103 | $av set $i $j [eval $weight [list $s $ss]] |
| 104 | } |
| 105 | $av set $i $i 0 |
| 106 | } |
| 107 | destructure {lv pv} [graph-shortest-path $av] |
| 108 | set i $index($p) |
| 109 | set pp [list $i] |
| 110 | for {set j 0} {$j < 256} {incr j} { |
| 111 | if {$i != $j && [$lv get $i $j] >= 0} { lappend pp $j } |
| 112 | } |
| 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] |
| 119 | set k $home |
| 120 | puts [world-summary [lindex $seed $k] 0 2] |
| 121 | foreach i [lrange $tsp 1 end] { |
| 122 | while {1} { |
| 123 | set k [$pv get $k $i] |
| 124 | if {$k < 0 || $k == $i} { break } |
| 125 | puts [world-summary [lindex $seed $k] 2 0] |
| 126 | } |
| 127 | puts [world-summary [lindex $seed $k] 0 2] |
| 128 | set k $i |
| 129 | } |
| 130 | if {$cycle} { |
| 131 | while {1} { |
| 132 | set k [$pv get $k $home] |
| 133 | if {$k < 0 || $k == $home} { break } |
| 134 | puts [world-summary [lindex $seed $k] 2 0] |
| 135 | } |
| 136 | } |