chiark - git - mdw - rocl/blob - elite-tantalus

   1 #! /usr/bin/tclsh
   2 #
   3 # $Id$
   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 gg {1 2 3 4 5 6 7 8}
  10 set maxdist 100
  11 set minratio 10
  12
  13 for {set i 0} {$i < [llength $argv]} {incr i} {
  14   set a [lindex $argv $i]
  15   switch -glob -- $a {
  16     "-maxdist" {
  17       incr i
  18       set maxdist [expr {int([lindex $argv $i] * 10)}]
  19     }
  20     "-minratio" {
  21       incr i
  22       set minratio [lindex $argv $i]
  23     }
  24     "--" {
  25       incr i
  26       break
  27     }
  28     "-*" {
  29       puts stderr "usage: $argv0 \[-maxdist DIST\] \[-minratio RATIO\] \[GALAXY\] ..."
  30       exit 1
  31     }
  32     default {
  33       break
  34     }
  35   }
  36 }
  37
  38 if {[llength $argv] > $i} {
  39   set gg [lrange $argv $i end]
  40 }
  41
  42 foreach g $gg {
  43   destructure {. gs} [parse-galaxy-spec $g]
  44   set l [elite-galaxylist $gs]
  45   set i 0
  46   foreach {w x y} $l {
  47     set index($w) $i
  48     incr i
  49   }
  50   elite-adjacency a $l
  51   set v [vector {256 256} -1]
  52   foreach {w x y} $l {
  53     set i $index($w)
  54     foreach {ww xx yy} $a($w) {
  55       set j $index($ww)
  56       $v set $i $j [elite-distance $x $y $xx $yy]
  57     }
  58     $v set $i $i 0
  59   }
  60   destructure {lv pv} [graph-shortest-path $v]
  61
  62   elite-adjacency b $l $maxdist
  63   foreach {w x y} $l {
  64     set i $index($w)
  65     foreach {ww xx yy} $b($w) {
  66       set d [elite-distance $x $y $xx $yy]
  67       if {$d <= 70 || [string compare $w $ww] > 0} { continue }
  68       set j $index($ww)
  69       set dd [$lv get $i $j]
  70       set r [expr {$dd/"$d.0"}]
  71       if {$r >= $minratio} {
  72         puts [format "%14s %s -> %s %4.1f %5.1f (%4.1f)" \
  73                   $g [world-brief $w] [world-brief $ww] \
  74                   [expr {$d/10.0}] [expr {$dd/10.0}] $r]
  75       }
  76     }
  77   }
  78   $v destroy
  79   $lv destroy
  80   $pv destroy
  81 }