#!perl
#
# $Id: spreadvect.pl,v 1.7 2005-08-26 16:38:43 ashted Exp $
#
# Take a single vectfile in vects and put it where it is supposed to be.
#
# Modification history:
# 24 Aug 2005  TA  Written

use strict;
use warnings;
use POSIX;
use Data::Dumper;

my @parts;
die "Expected one filename" unless @ARGV == 1;
die "Couldn't parse filename '$ARGV[0]'" unless 
  @parts = ($ARGV[0] =~ /kl_(\d+_\d+(?:_\d+)?)_([A-Za-z1-9_.-]+).vect/i) or
  @parts = ($ARGV[0] =~ /kl_(g[\d.g-]+g)_([A-Za-z1-9_.-]+).vect/i);
my $crossings;
if ($parts[0] =~ /^\d/) {
  ($crossings) = ($parts[0] =~ /^(\d+)/);
} else {
  my @crossings = sort { $a <=> $b } 
    map { abs($_) } grep { $_ } split(/[.g]+/,$parts[0]);
  $crossings = $crossings[-1];
}

my %knots;
if (open(DB,'KnotDB.pl')) {  # Read knot data if it exists.
  undef local $/;
  my $db = <DB>;
  close DB;
  eval $db;
}

my($ropelength,$edges,$edgelength,$upperbound,$residual);
print "Running ropelength . . .\n";
open(ROPELENGTH,"ropelength vects/$ARGV[0] |");
while (<ROPELENGTH>) {
  if (/:Ropelength:\s*(\S+)/) { 
    $ropelength = $1;
  } elsif (/Edges:\s*(\S+)\s*Average Edgelength:\s*(\S+)/) {
    $edges = $1;
    $edgelength = $2;
  }
}
close ROPELENGTH;

print "Running roundout_rl ... ";
open(ROUNDOUT,"roundout_rl -a 0.001 vects/$ARGV[0] |");
while (<ROUNDOUT>) {
  if (/e\^2-Upper Bound: (\d\S+)/) { # Depending on the radius one being second
    $upperbound = $1;
  }
}
print "$upperbound \n";

print "Running residual.pl ... ";
open(RESIDUAL,"residual.pl vects/$ARGV[0] | ");
while (<RESIDUAL>) {
    if (/Residual: (\S+)/) { 
	$residual = $1;
    }
}
close RESIDUAL;
print "$residual \n";

my $edge_bin = 'n'.(10**(floor(log($edges)/log(10)+0.5)));
my $len_bin = -floor(log($edgelength)/log(10)+0.5);
$len_bin = 0 if $len_bin < 0;
$len_bin = "l$len_bin";

# Add this into the database
$knots{$ARGV[0]} = { 
  knot_type => $parts[0],
  edges => $edges,
  edgelength => $edgelength,
  ropelength => $ropelength,
  upperbound => $upperbound,
  residual => $residual
};
# Unless we already have a better one, mark this the best.
# Note that an open configuration can never be the best.

unless ((defined($knots{$parts[0]}) and $knots{$parts[0]}{upperbound} <= $upperbound) and ($parts[0] !~ /open/)) {
  $knots{$parts[0]} = {
    filename => $ARGV[0],
    edges => $edges,
    edgelength => $edgelength,
    ropelength => $ropelength,
    upperbound => $upperbound,
    residual => $residual
  } 
}

print "Creating directories . . .\n";
for my $dir ("ByKnot","ByKnot/x$crossings","ByKnot/x$crossings/kl_$parts[0]",
             "ByEdgeCount","ByEdgeCount/$edge_bin",
             "ByEdgeLength","ByEdgeLength/$len_bin") {
  unless (-d $dir) {
    system('mkdir',$dir) and die "Could not create directory $dir";
    print "  $dir\n";
  }
}

print "Creating links . . .\n";
for my $dir ("ByKnot/x$crossings/kl_$parts[0]",
             "ByEdgeCount/$edge_bin",
             "ByEdgeLength/$len_bin") {
  my $up = $dir;
  $up =~ s/[^\/]+/../g;
  chdir $dir;
  unlink "$ARGV[0]";
  system('ln','-s',"$up/vects/$ARGV[0]","$ARGV[0]") 
    and die "Unable to symlink $up/vects/$ARGV[0] into $dir: $!";
  chdir $up;
}
if ($knots{$parts[0]}{filename} eq $ARGV[0]) {
  # This is the best, say so
  chdir "ByKnot/x$crossings/kl_$parts[0]";
  unlink "best.vect";
  system('ln','-s',$ARGV[0],'best.vect')
    and die "Unable to symlink $ARGV[0] to best.vect: $!";
  chdir "../../..";
}

# Write out the new database
rename 'KnotDB.pl','KnotDB.pl.prev';
open(KNOTDB,'>KnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;
