[rocl] / elite-salesman

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