1f21c804 |
1 | #! /usr/bin/tclsh |
2 | # |
b496a5c1 |
3 | # $Id: elite-salesman,v 1.2 2003/03/10 23:37:49 mdw Exp $ |
1f21c804 |
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]] |
b496a5c1 |
78 | if {[string equal $p ""]} { |
79 | puts stderr "$argv0: bad planet spec `[lindex $argv 1]'" |
1f21c804 |
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 | } |
b496a5c1 |
105 | $av set $i $i 0 |
1f21c804 |
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 | } |