#!/bin/perl

#
# This program searches the KnotDB database for knot types, then checks for the corresponding files.
#

use strict;
use warnings;
use File::Slurp;
use File::Copy;
use File::Path;
use Data::Dumper;
use Getopt::Long;

require 'tightknot_common.pl';

print STDERR "ckFiles_nomr 1.0: A consistency checker and updater for the NoMRKnotDB.pl database.\n";

my $checkknottypes = '';
my $force_sort = '';
my $force_tex = '';

GetOptions ( 'knottypes' => \$checkknottypes, 'forcesort' => \$force_sort, 'forcetex' => \$force_tex);

# We start by loading the database.

my $DBFILE = read_file('NoMRKnotDB.pl');
my %knots;
eval($DBFILE);

my %wknots = %knots;
my $numkeys = keys ( %wknots );
my $key;
my $rcond;

print "We have $numkeys entries in the original database.\n";

foreach $key (keys %wknots) {

  if ($key =~ /vect/) {

    unless (-f "./nomr/$key") {

      print "$key doesn't have a corresponding file.\n";
      delete $knots{$key};

    }

  }

}

print "Updating KnotDB to eliminate file entries w/o corresponding files...\n";

rename 'NoMRKnotDB.pl','NoMRKnotDB.old.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;

print "Looking for knot records which refer to pruned files...\n";

foreach $key (keys %knots) {

  if ($key !~ /vect/) {

    unless (-f "./nomr/$knots{$key}{filename}") {

      print "knot type $key refers to $knots{$key}{filename}, which doesn't exist.\n";

    }

    $knots{$key}{allfiles} = [ ];

  }

}

if ($checkknottypes) {

  print "Checking ./nomr to make sure that the filename agrees with knot type...\n";
  
  foreach $key (keys %knots) {
    
    if ($key =~ /vect/ && $key !~ /\#/ && $knots{$key}{knot_type} !~ /\d+\_\d+\_\d+/ && $key !~ /open/ && $key !~ /kl_0_1_/ && $key !~ /vvhires/) {  # a closed prime knot. 
      
      print "$key -> ";
      
      my @knottypes;
      open(KNOTTYPE, "knottype -qk ./nomr/$key |");
      while (<KNOTTYPE>) {
	if ($_ =~ m/\|(.+)\|/) {
	  push(@knottypes,$1);
	} 
	if ($_ =~ m/Unable to classify/) {
	push(@knottypes,$_);
      }
    }
      close KNOTTYPE;
      
      my $ktstring;
      
      $ktstring = join("",@knottypes);
      
      if ($ktstring !~ /<$knots{$key}{knot_type} \(1,1,e\)>/ && $ktstring !~ /Unable to classify/) {
	
	if ($ktstring =~ /<$knots{$key}{knot_type} \(-1,/) {
	  
	  print " is mirrored -> ";
	  
	  my $newfname;
	  $newfname = $key;
	  $newfname =~ s/\.vect/\.[-1,1,e]\.vect/;
	  
	  `whittenvect -qo \"(-1,1,e)\" ./nomr/$key `;
	  
	  print "$newfname -> ";
	  
	  rename ("./nomr/$key","./nomr/$key.bak");
	  move ("./nomr/$newfname","./nomr/$key") or die("Couldn't copy $newfname over ./nomr/$key.\n");
	  
	  print "./nomr/$key -> ";
	  
	  $knots{$key}{writhe} = undef; # remove writhing number from DB
	  
	  print "writhe set to undef";
	  
	} else {
	  
	  print "knot type actually $ktstring.\n"; 
	  die;
	  
	}
	
      } else {
	
	print "ok"
	  
    }
      
      print "\n";
      
    }
    
  }

}
  

print "Searching ./nomr for files which don't have records in the DB...\n";

chdir("./nomr/");
my @vglob;
@vglob = <*.vect>;
chdir("..");
my $thisfile;


my($ropelength,$edges,$edgelength,$upperbound,$residual,$mrlocs,$writhe);

foreach $thisfile (@vglob) {

  unless (defined $knots{$thisfile}) {

    print "Found file $thisfile which does not have an entry in NoMRKnotDB. Computing data...\n";
    
    #my @parts;
    #@parts = ($thisfile =~ /kl_(\d+_\d+(?:_\d+)?)_([A-Za-z1-9_.-]+).vect/i);

    my %parsehash;
    %parsehash = parsefilename($thisfile);

    print "File appears to have knot type $parsehash{knottype}.\n";
    
    $ropelength = undef;
    $edges = undef;
    $edgelength = undef;
    $upperbound = undef;
    $residual = undef;
    $rcond = undef;
    $mrlocs = undef;
    $writhe = undef;

    print "Running ropelength (with stiffness 0) . . .";
    open(ROPELENGTH,"ropelength ./nomr/$thisfile -L 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 "$ropelength.\n";
    
    print "Running residual.pl (with stiffness 0)... ";
    open(RESIDUAL,"residual.pl ./nomr/$thisfile -l 0 | ");
    while (<RESIDUAL>) {
      if (/Residual: (\S+)/) { 
	$residual = $1;
      }
    }
    close RESIDUAL;
    print "$residual \n";

    print "Running rcond (with stiffness 0) ... ";
    open(RESIDUAL,"rcond ./nomr/$thisfile -l 0 | ");
    while (<RESIDUAL>) {
      if (/Rcond: (\S+)/) { 
	$rcond = $1;
      }
    }
    close RESIDUAL;
    print "$rcond \n";

    print "Running writhecomp...\n";
    open(WRITHE,"writhecomp ./nomr/$thisfile | ");
    while (<WRITHE>) {
	if ($_ =~ m/writhe:\s+(\S+)/) { 
	    $writhe = $1;
        }
    }
    close WRITHE;

    unless (defined $ropelength && defined $residual && defined $rcond && defined $writhe) {

      die("Ropelength, residual, roundout, rcond, or writhecomp call failed for $thisfile.\n");

    }

    my %fname_stuff;

    %fname_stuff = parsefilename( $thisfile );

    $knots{$thisfile} = { 
		  knot_type => $parsehash{knottype},
		  edges => $edges,
		  edgelength => $edgelength,
		  ropelength => $ropelength,
		  residual => $residual,
		  upperbound => $ropelength,
		  rcond => $rcond,
		  writhe => $writhe,
		  cr => $fname_stuff{cr},
		  comp => $fname_stuff{comp},
		  index => $fname_stuff{index}
		 };

    if (scalar @{ $parsehash{summands}} > 1) {

      @{$knots{$thisfile}{summands}} = @{ $parsehash{summands}};

    }			   

    print "Added record $knots{$thisfile}.\n";
   
  }

}

rename 'NoMRKnotDB.pl','NoMRKnotDB.aold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;


print "Sorting files by knot type and updating knot records... \n";
foreach $key (keys %knots) {

  if ($key =~ /vect/ && $key !~ /open/ && $key =~ /nomr/ && $key !~ /stf/) {  

    # only vects with nomr somewhere in the name can play

    push @{$knots{$knots{$key}{knot_type}}{allfiles}}, $key;

  }

}

print "Updating NoMRKnotDB.pl to reflect added list of files of each knot type.\n";
rename 'NoMRKnotDB.pl','NoMRKnotDB.vold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;


print "Sorting files within each knot type by ropelength...\n";

foreach $key (keys %knots) {

  if ($key !~ /vect/) {

    @{$knots{$key}{allfiles}} = sort {$knots{$a}{upperbound} <=> $knots{$b}{upperbound}} @{$knots{$key}{allfiles}};

  }

}

print "Updating NoMRKnotDB.pl to reflect added list of files of each knot type.\n";
rename 'NoMRKnotDB.pl','NoMRKnotDB.vvold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;

print "Now updating the filename record in each knot type...\n";

foreach $key (keys %knots) {

  if ($key !~ /vect/) {

    if (scalar @{$knots{$key}{allfiles}} == 0) { # There are no longer any files for this knot type

      print "Deleting $key, which has no files...\n";
      delete $knots{$key};

    } else {

      my $bestfile;
      $bestfile = @{$knots{$key}{allfiles}}[0];
      
      my $okfile;
      my $searchfile;
      
      foreach $searchfile ( @{$knots{$key}{allfiles}} ) {
	
	if ($knots{$searchfile}{residual} < 0.01 && $knots{$searchfile}{edges}/$knots{$searchfile}{upperbound} > 8.0) {
	  
	  $okfile = $searchfile;
	  last;
	  
	}
	
      }
      
      if (defined $okfile && $okfile ne $bestfile) {
	
	print "\nWarning!\nbest ropelength in file $bestfile, but acceptable residual/rop in $okfile.\n";
	
	if ($knots{$okfile}{upperbound} - $knots{$bestfile}{upperbound} < 0.01) {
	  
	  print "we gain ropelength of ".($knots{$okfile}{upperbound} - $knots{$bestfile}{upperbound})." by this switch\n\n";
	  
	$bestfile = $okfile;
	  
	} else {
	  
	  print "ropelength gain of ".($knots{$okfile}{upperbound} - $knots{$bestfile}{upperbound})." UNACCEPTABLE! (no switch made)\n\n";
	  
	}
	
      }

      my @files;
      @files = @{$knots{$key}{allfiles}};
      
      if ($knots{$key}{filename} ne $bestfile ) {
	
	print "Updating $key ($knots{$key}{upperbound}) to file $bestfile ($knots{$bestfile}{upperbound}).\n";
	
	delete $knots{$key};
	
	$knots{$key}{upperbound} = $knots{$bestfile}{upperbound};
	$knots{$key}{ropelength} = $knots{$bestfile}{ropelength};
	$knots{$key}{edges} = $knots{$bestfile}{edges};
	$knots{$key}{edgelength} = $knots{$bestfile}{edgelength};
	$knots{$key}{residual} = $knots{$bestfile}{residual};
	$knots{$key}{filename} = $bestfile;
	$knots{$key}{rcond} = $knots{$bestfile}{rcond};
	$knots{$key}{mrlocs} = $knots{$bestfile}{mrlocs};
	$knots{$key}{writhe} = $knots{$bestfile}{writhe};
	$knots{$key}{cr} = $knots{$bestfile}{cr};
	$knots{$key}{comp} = $knots{$bestfile}{comp};
	$knots{$key}{index} = $knots{$bestfile}{index};
	
	if (defined $knots{$bestfile}{summands}) { @{$knots{$key}{summands}} = @{$knots{$bestfile}{summands}}; }
	
	@{$knots{$key}{allfiles}} = @files;
	
      }
      
    }
  }
}
      
print "Updating NoMRKnotDB.pl to reflect added list of files of each knot type.\n";
rename 'NoMRKnotDB.pl','NoMRKnotDB.vvvold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;
 
print "Scanning for knot types without a sort order...\n";
my $unsorted;
$unsorted = 0;

foreach ( keys %knots ) {

    if ($_ !~ /vect/) {  # this is a filename and not a knot type

	unless (defined ($knots{$_}{sortorder})) {

	    $unsorted++;
	    
	}

    }

}

if ($unsorted ne 0 || $force_sort) {

    print "Found $unsorted files without sort keys. Resorting...";

    my @sortedorder;
    @sortedorder = sorted_knot_types(\%knots,"includecomposites");

    print "Now assigning sortorder keys to knot types...\n";

    my $i;
    foreach $i (0..$#sortedorder) {

	$knots{$sortedorder[$i]}{sortorder} = $i;

    }

} else {

    print "Every knot type has a sort order. Will not resort.\n";

}


print "Updating NoMRKnotDB.pl to reflect sort order of knot types.\n";
rename 'NoMRKnotDB.pl','NoMRKnotDB.vvvvold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;

print "Scanning for knot types without TeX description....\n";

foreach (keys ( %knots )) {

  if ($_ !~ /vect/) {

    unless (defined($knots{$_}{tex}) && !($force_tex) ) {

      print "\t$_ now has TeX ";

      my %retstuff;

      %retstuff = parsefilename( $knots{$_}{filename} );
      $knots{$_}{tex} = $retstuff{tex};

      print "$retstuff{tex}.\n";

    }

  }

}

print "Updating NoMRKnotDB.pl to reflect TeX tags.\n";
rename 'NoMRKnotDB.pl','NoMRKnotDB.vvvold.pl';
open(KNOTDB,'>NoMRKnotDB.pl') or die "Unable to create Knot database.";
print KNOTDB Data::Dumper->Dump([\%knots],['*knots']),"\n";
close KNOTDB;
