chiark / gitweb /
Fix output formatting a little.
[rocl] / elite-salesman
CommitLineData
1f21c804 1#! /usr/bin/tclsh
2#
b496a5c1 3# $Id: elite-salesman,v 1.2 2003/03/10 23:37:49 mdw Exp $
1f21c804 4
5package require "elite" "1.0.1"
6package require "vector" "1.0.0"
7package require "graph" "1.0.0"
8
9set opts {}
10set weight weight-hops
11set d 70
12set cycle 1
13for {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
57set argv [lrange $argv $i end]
58if {[llength $argv] < 1 || [llength $argv] > 2} {
59 puts stderr "usage: $argv0 \[-OPTIONS\] \[-w WEIGHT\] \[-d DIST\] GAL \[WORLD\]"
60 exit 1
61}
62
63set g [parse-galaxy-spec [lindex $argv 0]]
64if {[string equal $g ""]} {
65 puts stderr "$argv0: bad galaxy spec `$g'"
66 exit 1
67}
68destructure {ng g} $g
69set ww [elite-galaxylist $g]
70if {[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
88array set index {}
89set seed {}
90set i 0
91foreach {s x y} $ww {
92 set index($s) $i
93 lappend seed $s
94 incr i
95}
96
97elite-adjacency adj $ww $d
98set av [vector {256 256} -1]
99foreach {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}
107destructure {lv pv} [graph-shortest-path $av]
108set i $index($p)
109set pp [list $i]
110for {set j 0} {$j < 256} {incr j} {
111 if {$i != $j && [$lv get $i $j] >= 0} { lappend pp $j }
112}
113puts -nonewline stderr "\[thinking..."
114destructure {dist tsp} \
115 [eval graph-travelling-salesman $opts -- [list $lv $pp]]
116puts stderr " done\]"
117puts "# Total metric = $dist"
118set home [lindex $tsp 0]
119set k $home
120puts [world-summary [lindex $seed $k] 0 2]
121foreach 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}
130if {$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}