#!perl
#
#
# Prepare a relatively detailed report on the state of the computation..
#
# Modification history:
# 24 Aug 2005  TA  Written

use strict;
use warnings;
use Lingua::EN::Numbers qw(num2en num2en_ordinal);
use File::Slurp;
use File::Copy;
use File::Temp;
use Data::Dumper;
use Cwd;

my $averagercond;

sub make_safekey {

    my $key = $_[0];
    my $safekey;
    my $texkey;

    my $cr;
    my $ind;
    my $comp;

    my $safeone;
    my $safetwo;
    my $safethree;
    
    if ( $key !~ /.vect/ ) {  #this is a knot type
	
	if ( $key =~ /(\d+)_(\d+)_(\d+)/ ) { # a link
	    
	    $safeone = $1; $safetwo = $2; $safethree = $3;

	    $cr = num2en($safeone); $comp = num2en($safetwo); $ind = num2en($safethree);
	    $cr =~ s/\s/\-/g; $comp =~ s/\s/\-/g; $ind =~ s/\s/\-/g;

	    $safekey = $cr.$comp.$ind;
	    $safekey =~ s/-//g;
	    $texkey = $safeone."^{".$safetwo."}_{".$safethree."}";

	    $cr = $safeone; $comp = $safetwo; $ind = $safethree;
	    
	} elsif ( $key =~ /(\d+)_(\d+)/ ) { # a knot
	
	    $safeone = $1; 
	    $safetwo = $2;
	    
	    $texkey = $safeone."_{".$safetwo."}";
    
	    $cr = num2en($safeone); $ind = num2en($safetwo);
	    $cr =~ s/\s/\-/g; $ind =~ s/\s/\-/g;

	    $safekey = $cr.$ind;
	    $safekey =~ s/-//g;
	
	    $cr = $safeone; $comp = 1; $ind = $safetwo;

	} else {

	    print "FAILED to match key ".$key."\n";

	}


    }
	
    my @retstuff = ($safekey,$texkey,$cr,$comp,$ind);

    return @retstuff;
	    
}

sub perltable {

    # We expect input in the following form

    # perltable(FILE,[40 50 50 50],["10.1 & 12", "14.1 & 11", "12.1 & 2"],"Temperature & Number of Fish","Water Temperature and Number of Fish Caught");

    my $fname=$_[0];
    my @rows=@{$_[1]};
    my @data=@{$_[2]};
    my $colheads=$_[3];
    my $caption=$_[4];
    my $maxcols=$_[5];
    my $label=$_[6];

    my $tab = 0;
    my $tabdatastart = 0;  #The first piece of data in this table.

    open(TABLE,">$fname") or die("Couldn't open $fname:$_\n");
    print "Called perltable with ".scalar @rows." tables of rows and ".scalar @data." data\n";

    foreach $tab (0..scalar @rows) {

	print "Survived to table $tab.\n";

	if (!defined($data[$tabdatastart])) { return; }

	my $cols =  int( scalar @data/$rows[$tab] + 1); 
	if ($cols > $maxcols) { $cols = $maxcols; }
	my $onetab = scalar @data/($maxcols*$rows[0]) < 1;

        # Number of entries / $rows on this table entries per col.

	print "Making Perl Table $tab of $rows[$tab] x $cols entries of ".scalar @data." total pieces of data.\n";
	my $colsperentry = ($colheads =~ tr/&//) + 1;
	print "Counting $colsperentry columns per item in data.\n";

	if (scalar @data - $tabdatastart < $rows[$tab]*$cols) { # We're on the last table

	    $rows[$tab] = int( (scalar @data - $tabdatastart + $cols-1)/$cols) + 1;
	    if ($rows[$tab] > 1) { $rows[$tab]--; } 

	    print "Balancing last table by resetting rows to $rows[$tab].\n";

	}

	print TABLE '\begin{table}[h]'."\n";
	print TABLE '\caption{\label{'.$label.num2en($tab+1).'}';
	if (!$onetab) { print TABLE 'Table '.($tab+1).' of '; }
	print TABLE $caption.'}'."\n";

	foreach my $j (0..$cols-1) {

	    if (defined $data[$tabdatastart + $j*$rows[$tab]]) {

		print TABLE '\begin{tabular}[t]{'.("l" x ($colsperentry)).'} \toprule'."\n";
		print TABLE $colheads."\\\\ \\midrule \n";

		foreach my $i (0..$rows[$tab]) {

		    my $ind = $tabdatastart + $i + $j*$rows[$tab];

		    if (defined $data[$ind]) {

			print TABLE "$data[$ind]";
			
		    } 

		}

		print TABLE '\bottomrule'."\n".'\end{tabular}'."\n";
		print TABLE '\hspace{0.25in}'."\n";

	    }

	}
	
	print TABLE '\end{table}'."\n";

	# We now update $tabdatastart;

	$tabdatastart += $rows[$tab]*$cols;

    }

    $|++;
    close(TABLE);

}

#open(DB,'KnotDB.pl');
my $DBFILE = read_file('NoMRKnotDB.pl');
my %knots;

eval($DBFILE);

#close(DB);

my $okknots;
$okknots = 0;

my $okcomposites;
$okcomposites = 0;

my $totalcomposites;
$totalcomposites = 0;

my $totalknots;
$totalknots = 0;

my $key;

print "Checking NoMR database for potential knot okness.\n";

foreach $key ( keys %knots ) {

    if ($key =~ m/vect/) {

      $totalknots++;

      if (defined($knots{$key}{summands})) {

	$totalcomposites++;

      } 

      if ($knots{$key}{residual} < 0.01 && $knots{$key}{upperbound}/$knots{$key}{edges} < 1/8.0) {
	
	push @ { $knots{$knots{$key}{knot_type}}{okfiles} }, $key;
	$okknots++;
	#print "Found an acceptable $knots{$key}{knot_type}.\n";

	if (defined($knots{$key}{summands})) {

	  $okcomposites++;

	}
	
      }

    }

}

print "We have $okknots acceptable knots of $totalknots, including $okcomposites of $totalcomposites composite knots.\n";


my $numkeys = keys ( %knots );
print "We have $numkeys entries in the original database. Looking for knots.\n";

# first, a pass to remove files from the hash

foreach $key ( sort(keys %knots) ) {

    if ($key =~ /.vect/) {

	delete $knots{$key};

    }

}

$numkeys = keys ( %knots );
print "There seem to be $numkeys knots and links in the database. Generating TeX macros and data...\n";
print "We have $okknots acceptable (resolution > 8, residual < 0.01) finished runs\n";

my $safekey;
my $texkey;
my $cr;
my $comp;
my $ind;

foreach $key ( sort(keys %knots) ) {

  $texkey = $knots{$key}{tex};
  $cr = $knots{$key}{cr};
  $comp =   $knots{$key}{comp};
  $ind =  $knots{$key}{index};

    # Now some formatting modifications for the table.
  
  $knots{$key}{ropelength} = sprintf("%2.4f",$knots{$key}{ropelength});
  $knots{$key}{upperbound} = sprintf("%2.4f",$knots{$key}{upperbound});
  
}

# We first delete manually some troublesome cases

my @knotlist = sort{ $knots{$a}{sortorder} <=> $knots{$b}{sortorder} } keys( %knots ) ;

print "Now organizing the table by crossing number...\n";

my @bycrossing;

foreach $key ( @knotlist ) {

    if (defined $knots{$key}{cr}) { push(@{ $bycrossing[$knots{$key}{cr}] },$key); }

}

print "There are ".scalar @knotlist." knot types in the database.\n";
print "Of these:\n\n";

my $j;
for($j=0;$j<13;$j++) {

    if (defined $bycrossing[$j]) {

	print scalar @{ $bycrossing[$j] }." are $j crossing knots.\n";
	
    }
}
print "\n";

my @knots;
my @links;
my @straight;
my @kinks;
my @nokinks;
my @primes;
my @composites;

foreach $key ( @knotlist ) {

    if ($knots{$key}{comp} == 1) { 
	
	push(@knots,$key); 
	
    } else { 

	push(@links,$key);

    }
    
    if (defined $knots{$key}{straight}) {

	push(@straight,$key);

    }

    if (defined($knots{$key}{kinks}) and ($knots{$key}{kinks} > 0)) {

	push(@kinks,$key);

    } else {

        if (!defined($knots{$key}{summands})) { push(@nokinks,$key); }
    
    }

    if (defined($knots{$key}{summands})) {

      push (@composites,$key);

    } else {

      push (@primes,$key);

    }

}

open COUNTS, ">fileCounts_nomr.tex" or die("Unable to open fileCounts_nomr.tex.\n");

print scalar @knots." are knots\n";
print scalar @links." are links\n\n";
print scalar @straight." have straight segments\n";
print scalar @kinks." have kinks\n";
print scalar @primes." are prime\n";
print scalar @composites." are composite\n\n";

#print "The only prime knots and links without kinks are \n";
#foreach ( @nokinks ) {

#  print "$_ \n";

#}

print COUNTS "\\newcommand\{\\NoMRFileCount\}\{".(scalar @knots + scalar @links)."\}\n";
print COUNTS "\\newcommand\{\\NoMRKnotCount\}\{".scalar @knots."\}\n";
print COUNTS "\\newcommand\{\\NoMRLinkCount\}\{".scalar @links."\}\n";
print COUNTS "\\newcommand\{\\NoMRStraightCount\}\{".scalar @straight."\}\n";
print COUNTS "\\newcommand\{\\NoMRKinkCount\}\{".scalar @kinks."\}\n";
print COUNTS "\\newcommand\{\\NoMRPrimeCount\}\{".scalar @primes."\}\n";
print COUNTS "\\newcommand\{\\NoMRCompositeCount\}\{".scalar @composites."\}\n";

my @ok;
my @notok;

foreach $key ( @knotlist ) {

  unless (defined $knots{$key}{edges} && defined $knots{$key}{upperbound} && $knots{$key}{residual} ) {
    
    print "Warning: $key doesn't have edge count, upperbound or residual. $knots{$key} \n";
    
  }
  
  if ($knots{$key}{edges}/$knots{$key}{upperbound} > 8.0 && $knots{$key}{residual} < 0.01) {
    
    push (@ok, $key);
    
  } else {
    
    push (@notok, $key);
    
  }

}

print COUNTS "\\newcommand\{\\NoMRDoubleOOneCount\}{".scalar @ok."\}\n";

print scalar @ok." have residual < 0.01 and resolution > 8 (report in alldone_nomr.txt)\n";
print scalar @notok. " do not meet these standards (report in tocontinue_nomr.txt)\n";

@ok = sort { $knots{$a}{residual} <=> $knots{$b}{residual} } @ok;

print "\n[$knots{$ok[0]}{residual}, $knots{$ok[$#ok]}{residual}] residuals.\n";

my $averageresidual;
foreach ( @ok ) {$averageresidual += $knots{$_}{residual};}
$averageresidual /= $#ok;
print "$averageresidual is the average residual among converged knot types.\n\n";

printf COUNTS "\\newcommand\{\\NoMRMinResidual\}\{%4.3g\}\n",$knots{$ok[0]}{residual};
printf COUNTS "\\newcommand\{\\NoMRMaxResidual\}\{%4.3g\}\n",$knots{$ok[$#ok]}{residual};
printf COUNTS "\\newcommand\{\\NoMRAverageResidual\}\{%4.3g\}\n",$averageresidual;

my @tripleos;
foreach ( @ok ) { if ($knots{$_}{residual} < 0.001) { push @tripleos, $_; } }
print COUNTS "\\newcommand\{\\NoMRTripleOOneCount\}{".scalar @tripleos."\}\n";
print scalar @tripleos." knots are converged to within 0.001 \n";

#my $averagestruts;
#foreach ( @ok ) {$averagestruts += $knots{$_}{struts};}
#$averagestruts /= $#ok;
#print "$averagestruts is the average number of struts among converged knot types.\n\n";

#my $averagemrlocs;
#foreach ( @ok ) {$averagemrlocs += $knots{$_}{mrlocs};}
#$averagemrlocs /= $#ok;
#print "$averagemrlocs is the average number of mrlocs among converged knot types.\n\n";

my $averageedgelength;
foreach ( @ok ) {$averageedgelength += $knots{$_}{edgelength};}
$averageedgelength /= $#ok;
print "$averageedgelength is the average edgelength among converged knot types.\n\n";

my $averageedges;
foreach ( @ok ) {$averageedges += $knots{$_}{edges};}
$averageedges /= $#ok;
print "$averageedges is the average edges among converged knot types.\n\n";


#print COUNTS "\\newcommand\{\\NoMRAverageStruts\}\{".int($averagestruts)."\}\n";
#print COUNTS "\\newcommand\{\\NoMRAverageMrlocs\}\{".int($averagemrlocs)."\}\n";
print COUNTS "\\newcommand\{\\NoMRAverageEdges\}\{".int($averageedges)."\}\n";

printf COUNTS "\\newcommand\{\\NoMRAverageEdgelength\}\{%4.2g\}\n",$averageedgelength;

#print COUNTS "\\newcommand\{\\NoMRMatrixDims\}\{".(int($averagestruts) + int($averagemrlocs))." \\times ".3*int($averageedges)."\}\n";

my ($matrixents,$matrixnnz);

#$matrixents = ((int($averagestruts) + int($averagemrlocs))*3*int($averageedges));
#$matrixnnz = (12*int($averagestruts) + 9*int($averagemrlocs));

#print COUNTS "\\newcommand\{\\NoMRMatrixEnts\}\{$matrixents\}\n";
#print COUNTS "\\newcommand\{\\NoMRMatrixNNZ\}\{$matrixnnz\}\n";
#printf COUNTS "\\newcommand\{\\NoMRMatrixSparsity\}\{%4.3g\\\%\}\n",100.0*($matrixents - $matrixnnz)/($matrixents);

my @rcondoks;
my $guy;

foreach $guy ( @ok ) {

    if ($knots{$guy}{rcond} != 0) { push @rcondoks, $guy; }

}

@rcondoks = sort { (1.0/$knots{$a}{rcond}) <=> (1.0/$knots{$b}{rcond}) } @rcondoks;
my $mincond;
my $maxcond;
$mincond = 1.0/$knots{$rcondoks[0]}{rcond};
$maxcond = 1.0/$knots{$rcondoks[$#rcondoks]}{rcond};

print "\n[$mincond,$maxcond] condition numbers.\n";

foreach ( @rcondoks ) {$averagercond += 1.0/$knots{$_}{rcond};}
$averagercond /= $#rcondoks;
print "$averagercond is the average condition number among converged knot types with nonzero rcond.\n\n";


printf COUNTS "\\newcommand\{\\NoMRMinCond\}\{%g\}\n",$mincond;
printf COUNTS "\\newcommand\{\\NoMRMaxCond\}\{%g\}\n",$maxcond;
printf COUNTS "\\newcommand\{\\NoMRAverageCond\}\{%g\}\n",$averagercond;

 
open(TOCONTINUE,">tocontinue_nomr.txt"); 

my ($ropelength,$residual,$filename,$resolution);

foreach $key (@notok) {

    $resolution = $knots{$key}{edges}/$knots{$key}{upperbound};
    $ropelength = $knots{$key}{upperbound};
    $filename = $knots{$key}{filename};
    $residual = $knots{$key}{residual};

    write(TOCONTINUE);

}

close TOCONTINUE;

open(OK,">alldone_nomr.txt"); 

foreach $key (@ok) {

    $resolution = $knots{$key}{edges}/$knots{$key}{upperbound};
    $ropelength = $knots{$key}{upperbound};
    $filename = $knots{$key}{filename};
    $residual = $knots{$key}{residual};

    write(OK);

}

close OK;

my $i;
my $deleted;
my @nopb;
my @pb;

# We start by loading the other database. 

my %temp;
%temp = %knots;
my %l1knots;

print "Loading KnotDB.pl as comparison....\n";

#open(DB,'KnotDB.pl');
my $KDBFILE = read_file('KnotDB.pl');
eval($KDBFILE);

%l1knots = %knots;
%knots = %temp;

print "$l1knots{'3_1'}\n";

foreach $i (0..$#ok) {

  unless (defined $l1knots{$ok[$i]}) { push @nopb, $ok[$i];} 
  else { push @pb, $ok[$i]; }

}

print "Deleted ".scalar @nopb." elements from ok list (@nopb) because I can't match with KnotDB.pl ...\n";

@pb = sort {
                (0 -$l1knots{$a}{ropelength} + $knots{$a}{ropelength}) <=> 
	      (0 -$l1knots{$b}{ropelength} + $knots{$b}{ropelength}) 

	    } @pb;

print "Winners over lambda = 1 data\n";
print "----------------------------------\n";

my $positive;
my $negative;
my $avg;

foreach (0..$#pb) { 

  print "$pb[$_] ".$knots{$pb[$_]}{ropelength}." wins by ".100.0*(($l1knots{$pb[$_]}{ropelength} - $knots{$pb[$_]}{ropelength})/($knots{$pb[$_]}{ropelength}))." \% over the bound {$l1knots{$pb[$_]}{ropelength}} of KnotDB.pl.\n";

 if ($l1knots{$pb[$_]}{ropelength} - $knots{$pb[$_]}{ropelength} > 0) {$positive++;} else {$negative++};

  $avg += 100*($l1knots{$pb[$_]}{ropelength} - $knots{$pb[$_]}{ropelength})/($knots{$pb[$_]}{ropelength});
  
}

$avg /= $#pb;

print "------------------------------------------------------------------------\n";
print "We beat the bound (by avg of $avg %) in $positive cases and lost in $negative cases.\n";
print "------------------------------------------------------------------------\n";

print COUNTS "\\newcommand\{\\NoMRWonCases}\{$positive\}\n";
print COUNTS "\\newcommand\{\\NoMRLostCases\}\{$negative\}\n";
printf COUNTS "\\newcommand\{\\NoMRAverageWin\}\{%4.3f\}\n",$avg;

close COUNTS;

copy("./fileCounts_nomr.tex","../rrpaper/fileCounts_nomr.tex") or warn("Coudn't refresh the copy of fileCounts_nomr in rrpaper dir.\n");

my $sourcename;
my $targetname;
my $cwd;

$cwd = getcwd;

print "Recreating ./unfinishednomr directory of files which don't meet quality standards.\n";

my $tempdir;
$tempdir = File::Temp->newdir();
mkdir("$tempdir/unfinishednomr") or die("Couldn't make $tempdir/unfinishednomr");

foreach $key (@notok) {

    $resolution = $knots{$key}{edges}/$knots{$key}{upperbound};  
    $sourcename = "./nomr/$knots{$key}{filename}";

    if ($resolution < 8 || $resolution > 9) {

	copy($sourcename,"temp.vect");
	`splinevect -r 8 temp.vect`;
	$sourcename = "temp.r8.vect";
	
    };
	
    $targetname = "$tempdir/unfinishednomr/kl_".$key."_nomrunfinished.vect";

    #print "$sourcename -> $targetname ...";
    copy($sourcename,$targetname) or die("failed\n");
    #print "ok\n";

    if (defined $knots{$key}{okfiles} ) {

	#print "there are ".scalar @ { $knots{$key}{okfiles} }." alternate files\n";

    } else {

	#print "there are no alternate files.\n";

    }

    unlink("temp.vect");

}

chdir($tempdir);
`tar -czf unfinished_nomr.tar.gz unfinishednomr`;
chdir($cwd) or die("Couldn't change back to $cwd");
move("$tempdir/unfinished_nomr.tar.gz","./unfinished_nomr.tar.gz") or die("Couldn't move unfinished_nomr.tar.gz back to TightKnot");

print "Tar'd results to unfinished_nomr.tar.gz\n";

format TOCONTINUE_TOP =

     Files that need more work

     Filename               Resolution          Residual            Ropelength
     ---------------------  ------------------  ------------------  ----------------
.

format TOCONTINUE = 
     @<<<<<<<<<<<<<<<<<<<<  @####.############  @####.############  @###.###########
     $filename,             $resolution,        $residual,          $ropelength 
.

format OK_TOP =

     Files that are ok.

     Filename               Resolution          Residual            Ropelength
     ---------------------  ------------------  ------------------  ----------------
.

format OK = 
     @<<<<<<<<<<<<<<<<<<<<  @####.############  @####.############  @###.###########
     $filename,             $resolution,        $residual,          $ropelength 
.
