#!/usr/bin/perl -w
# COMPFt [options] [-F Percent] [-S File.ccf]

#  COMPFt script (measure component outputs and run times)
#  Use system.pscf file to process all stateless components and create .ccft files
#  that contain their measured approximations.  Can graph and print error analysis.
#  Does just one .ccf file with -S option (usual case, from COMP).
#  May do incremental processing for small changes in .ccf file.
#  Always creates .cm (conduction matrix) file(s) for component(s).

use sampling;
use CompCheck2;
use File::Copy;
use component;

$eps = 1.0e-14;  # smallest safe double-float value

$Goption = 0; # graph the result
$Soption = 0; # single .ccf file follows; do just that one
$Coption = 1; # default step function approximation
$Loption = 0; #  linear
$Boption = 1; # use best-fit for lines (default); maybe fit endpoints later
$LCoption= 0; # linear for function, step for runtime
$CLoption= 0; # step for function approximation peice-wise linear for runtime
$Voption = 0; # print too many messages
$Foption = 0; # confidence percentage follows; do reliability in place of run time

OPT: for ($i = 0;;$i++) { #over all options
  unless (defined($ARGV[$i])) {last OPT;}
  if ($ARGV[$i] eq "-C") {
    $Coption = 1; $Loption = 0;
    $LCoption= 0; $CLoption= 0;
    $currentflag = "C";
  }
  if ($ARGV[$i] eq "-L") {
    $Coption = 0; $Loption = 1;
    $LCoption= 0; $CLoption= 0;
    $currentflag = "L";
    $Boption = 1; #assume best fit; maybe do endpoints later
  }
  if ($ARGV[$i] eq "-CL") {
    $Coption = 0; $Loption = 0;
    $LCoption= 0; $CLoption= 1;
    $currentflag = "CL";
  }
  if ($ARGV[$i] eq "-LC") {
    $Coption = 0; $Loption = 0;
    $LCoption= 1; $CLoption= 0;
    $currentflag = "LC";
  }
  if ($ARGV[$i] eq "-B") {
    $Boption = 1;
  }
  if ($ARGV[$i] eq "-G") {
    $Goption = 1;
  }
  if ($ARGV[$i] eq "-V") {
    $Voption = 1;
  }
  if ($ARGV[$i] eq "-F") {
    $Foption = 1;
    unless(defined($ARGV[$i+1]) && $ARGV[$i+1] >0 && $ARGV[$i+1] < 100) {
    die "Reliability % impossible";
    }
    unless ($Coption || $LCoption) {
    $LCoption = 1;
    }
    $confidencepct = $ARGV[$i+1];
  }
  if ($ARGV[$i] eq "-S") {
    $Soption = 1; 
    unless(defined($ARGV[$i+1]) && $ARGV[$i+1] =~ m/.ccf$/) {
      die "Error reading .ccf file\n";
    }
    @components = ($ARGV[$i+1]);  # single .ccf file name
  }
} #end options loop

$i = 0;
unless ($Soption) {
  #process system configuration file
  $sys_desc = "system.pscf" ;
  open(SYSTEM, $sys_desc ) || die "could not open the file ", $sys_desc ;
  $comp_name = <SYSTEM>; #discard polish line

  #store component .ccf names
  @components = ();
  while ($comp_name = <SYSTEM>) { #read to end
    chop($comp_name);
    $components[$i] = $comp_name;
    $i++
  }
  close SYSTEM ;
}

#foreach $comp (@components) {print $comp."\n"; }  #debug

########################################subroutine#######################
sub warnmess{ #print warning based on V option
  unless ($Voption && defined($_[0])) {return;}
  $mess = "";
  MLOOP: for ($wm=0;;$wm++) {
    unless (defined($_[$wm])) {last MLOOP;}
    $mess = $mess.$_[$wm];
  }
warn $mess, "\n";  #don't print line from which this came...
}
#######################################################################

sub fitline {
# If -B option, best-fit line in the sense of least squares of differences
# Otherwise, fit line at interval ends (really the last and first points measured)
# parameters:  $_[0] - X-vector; $_[1] - Y-vector; $_[2] - X-ave; $_[3] - Y-ave; $_[4] - Count
my($xvec, $yvec, $xave, $yave, $N, $Slope, $Inter, $dev, $cross, $var, $i);
$xvec = $_[0];
$yvec = $_[1];
$xave = $_[2];
$yave = $_[3];
$N = $_[4];
if ($Boption) { #best-fit the line
  $cross = 0;
  $var = 0;
  for ($i=0; $i<$N; $i++) {
    $cross += @$xvec[$i] * @$yvec[$i];
    $var += @$xvec[$i] * @$xvec[$i];
  }
  if ($N == 1) {
    $Slope = 0;
  }
  else {
    $Slope = ($cross/$N - $yave*$xave)/($var/$N - $xave*$xave);
  }
  if (abs($cross/$N - $yave*$xave) <= $eps) {
  #$a = $cross/$N; $b = $yave*$xave; $c = $var/$N; $d = $xave*$xave; print "$Slope $a - $b / $c - $d\n"; #debug
    $Slope = 0;
  }
  $Inter = $yave - $Slope*$xave;
} else { #not -B, fit just to first/last points; can't happen just now
  $x0 = $sub_start;
  $y0 = $Lord;
  $deltaX = $sub_end - $x0;
  $deltaY = $Rord - $y0;
  if ($deltaY == 0 || $deltaX == 0) {
    $Slope = 0;
    $Inter = $yave;  #degenerate cases
  } else {
    $Slope = $deltaY/$deltaX;
    $Inter = $y0 - $Slope*$x0;
  }
} #end not -B
$dev = 0;
for ($i=0; $i<$N; $i++) {
  $dev += ($Slope*@$xvec[$i] + $Inter -@$yvec[$i])**2;
}
$dev = sqrt($dev/$N); #rms deviation from the line; #not normalized
return $Slope, $Inter, $dev;
#  return (slope,intercept,deviation) of the fitted line
}
#########################################################################

#for each component process its file and execute test
CCFL: 
foreach $comp (@components) {
  open(COMP, $comp) || die "could not open the file ", $comp;
  # get the name of the executable
  $comp_line = <COMP> ;
  @comp_and = split(' ',$comp_line);
  $comp_name = $comp_and[0];
  if ($comp_name eq "theory") { #not a real component, skip
    next CCFL;
  }
  #real component, check
#$ok = 1; $stateless = 1;  #debug by switching comment to next line
 ($stateless, $concurrent, $ok) = &CompCheck::check1($comp,$Voption);
  unless ($ok) { # .ccf bad, messages already given
    next CCFL;
  }
  if (!$stateless || $concurrent) { #can't process with two "inputs"
    warn "Ignored component $comp that has state or concurrency ...";
    next CCFL;
  }
  #reaching here means OK to process
  $comptheory = $comp."t";  #assuming name ends in .ccf
  $ccftsExist = 1; #assume there is a good .ccft file
  $incrproc = 0; #assume no incremental processing
  if (-e $comptheory) {
    open (CCFT, $comptheory);
    $tmp = <CCFT>; #examine the code line
    @tmp = split(" ",$tmp);
    $ccftsExist = 0 unless (((defined($tmp[1]) && ($tmp[1] eq "L")) && $Loption) || (($tmp[1] eq "C") && $Coption) 
      || (($tmp[1] eq "CL") && $CLoption) || (($tmp[1] eq "LC") && $LCoption)); 
    if ($Foption) {
      $ccftsExist = 0 unless (defined($tmp[3]) && ($tmp[2] eq "r") && ($tmp[3] == $confidencepct));
    }
    @statvec = stat($comp); #for ccf file
    $ccfileTime = $statvec[9];
    @statvec = stat($comp_name); #for executable file
    $binfileTime = $statvec[9];  
    @statvec = stat($comptheory); #for theory ccf file
    $ccftsExist = 0 unless ($statvec[9] > $binfileTime);
    if ($statvec[9] < $ccfileTime && $statvec[9] > $binfileTime) {
      $incrproc = 1;
      $ccftsExist = 0;
    }
    close (CCFT);
  } else {
    $ccftsExist = 0;
  }
  close(COMP);
  if ($ccftsExist) { #there is an OK .ccft file
    warnmess "Testing measurements file $comptheory up-to-date..." ;
    warnmess "--------------------------------";
    next CCFL;
  }
  if ($incrproc) { #attempt incremental
#$incrproc = 0;  #debug:  switch comment to next line
    $incrproc = &CompCheck::CheckIncr($comp); #creates .ccfi skeleton if small changes
  }
  warnmess "Creating testing-measurements file $comptheory...";
  if ($incrproc) {  #may be changed in CheckIncr
    $oldtheory = $comptheory."b";
    copy($comptheory, $oldtheory);
    #system "rm -f $oldtheory";
    #system "cp $comptheory $oldtheory";  # .ccftb is previous theory file
    #messages printed below...
  } else { #seperator
    warnmess "--------------------------------";
  }
  #die "stop and look at all files!";  #debug
  open(COMPTH, ">".$comptheory)  || die "could not create theory file ", $comptheory;
  if ($incrproc) {
    open(OLDTH, "<$oldtheory");
    $tl = <OLDTH>;  #header line
    print COMPTH $tl; #copy header line from old file
  } else {
    $code = "theory ";
    if($Loption){
      $code = $code."L";
    }elsif($Coption){
      $code = $code."C";
    }elsif($LCoption){
      $code = $code."LC";
    }elsif($CLoption){
      $code = $code."CL";
    }
    if ($Foption) { #theory LC r confidence
      $code = "theory LC r ".$confidencepct; #mark that file is reliability with that %
      $LCoption = 1; #never mind what was said about LC
    }
    print COMPTH "$code \n";
  }
  #read subdomain information
  open(COMP,$comp);
  $linearr = <COMP>; #eat the header line
  if ($incrproc) { #read and store correction file
    $corr = $comp."i";
    open(CORR,"<$corr") || die "Incremental processing file $corr missing";
    $corrcount = 0;
    while($clinearr = <CORR>) {
      $cl[$corrcount++] = $clinearr;
    }
    #print "$corrcount correction lines\n";  #debug
    close(CORR);
    $incrline = 0;  #initial index
    @cline = split(' ',$cl[$incrline++]);
    $cleof = 0;  
  }
  $linescopied = 0;
  $linesmeas = 0;
  
  @base = split('\.',$comp);  #usual bad job with elaborate file names...
  $cmname = $base[0]."-".$base[0].".cm";
  open (CM, "> $base[0].cm") || die "Can't create conduction matrix for $base[0]";
  print CM "$base[0]\n";  #list of components inside (just myself)
  close(CM);
  open (CM, "> $cmname") || die "Can't create conduction matrix file $cmname";
  ML:
  while($linearr = <COMP>) { #loop control is the current .ccf file
    # .ccf line and .ccfi line are current; .ccftb line is behind these
    @line = split(' ',$linearr);
#print "ccf line: $linearr";   #debug
    if ($incrproc && !$cleof && ($cline[0] <= $line[0])) { # the change applies here
#print "Incremental meas\n";  #debug
      $linesmeas++;
      $sub_start = $cline[0];
      $sub_end = $cline[1];
      $test_cnt = $cline[2];
      #advance the other data struct
      if ($incrline < $corrcount) { #another change line, set up
        @cline = split(' ',$cl[$incrline++]); 
      } else { # no more change lines
        $cleof = 1;
      }
      # fall into the measurement code for this subdomain
    } else { #measure 
      if ($incrproc) { #but not a change line; copy from old .ccft file
#print "Incremental copy\n";  #debug
        $keepon = 1;
        while ($keepon && ($thline = <OLDTH>)) { #copy old line(s)  
#print "th: $thline";  #debug
          @thbits = split(' ',$thline);
          if ($thbits[0] >= $line[0]) { #we need this one (else just skip)
            print COMPTH $thline;
            $linescopied++;
          }
          if ($thbits[1] >= $line[1]) { #no more of old needed
            $keepon = 0;
          }
        }
        next ML;  #skip measurement for this subdomain
      } else { #non-incremental regular measurement
        $sub_start = $line[0] ;
        $sub_end = $line[1] ;
        $test_cnt = $line[2] ;
        $linesmeas++;
      }
    }
    if ($Foption) { #reliability, fake subroutine size to 100 times
      $rely = exp(log(1-$confidencepct/100.0)/(100.0*$test_cnt));
    }
    &sampling::init($sub_start, $sub_end, $test_cnt);
    #for !-B, get values at interval ends
    unless ($Boption) {
      ($Ly,$Lt) = component::excomp($sub_start,$comp_name);
      ($Ry,$Rt) = component::excomp($sub_end,$comp_name);
    } #end B-option
    #need an else here?!
    $cnt = 0 ;
    $input = &sampling::next ;
    #for each subdomain get equi-spaced input and call components with this
    @x_vals = ();  #inputs
    $x_bar = 0;  #average
    @y_vals = ();  #functional outputs
    $y_bar = 0;
    $y_sqrs = 0;
    @t_vals = ();  #run times
    $t_bar = 0;
    $t_sqrs = 0;
    while($input ne ".") {
      $x_vals[$cnt] = $input;
      $x_bar += $input;
      ($y,$t) = component::excomp($input,$comp_name);
      $y_vals[$cnt] = $y;
      $y_bar += $y;
      $y_sqrs += $y*$y;
      $t_vals[$cnt] = $t;
      $t_bar += $t;
      $t_sqrs += $t*$t;
      $input = &sampling::next ;
      $cnt++ ;
    } #end loop over inputs, one subdomain
    $x_bar /= $cnt;
    $y_bar /= $cnt;
    $t_bar /= $cnt;
    if ($Loption || $LCoption) { #functional line
      $Lord = $Ly;
      $Rord = $Ry;
      ($V_slope, $V_inter, $V_dev) = fitline(\@x_vals, \@y_vals, $x_bar, $y_bar, $cnt);
    } else { #functional constant
      $V_slope = 0;
      $V_inter = $y_bar;
      $V_dev = sqrt(abs($y_sqrs - $cnt*$y_bar*$y_bar)/$cnt); #not normalized
    }
    if ($Foption) { #reliability
      $R_slope = 0;
      $R_inter = $rely;
      $R_dev = $confidencepct;
    } else {
      if ($Loption || $CLoption) { #run line
        $Lord = $Lt;
        $Rord = $Rt;
        ($R_slope, $R_inter, $R_dev) = fitline(\@x_vals, \@t_vals, $x_bar, $t_bar, $cnt);
      } else { #run constant
        $R_slope = 0;
        $R_inter = $t_bar;
        $R_dev = sqrt(abs($t_sqrs - $cnt*$t_bar*$t_bar)/$cnt); #not normalized
      }
    }
    print COMPTH "$sub_start $sub_end $V_slope $V_inter $R_slope $R_inter $V_dev $R_dev\n";
    # the _dev values are rms, not normalized (Xcute will do)

#print "N: $cnt, xave: $x_bar, yave: $t_bar, stdev: $y_sdev\n"; #debug
   #print "rms: $V_dev, Rrms: $R_dev"; print "\n";  #debug

  } #end ML loop over subdomains, one component
$nsubds = $linescopied+$linesmeas;
$cmline = "0";
for ($i=1; $i<$nsubds; $i++) {
  $cmline .= " 0";
}
$cmline .= "\n";
#make diagonal matrix
for ($i=0; $i<$nsubds; $i++) {
  @blank = split(' ',$cmline);
  $blank[$i] = 1;
  $uni = join(' ',@blank);
  print CM "$uni\n";
}
close (CM); 

if ($incrproc) {
warnmess "  Incremental measurements: $linescopied subdomains copied; $linesmeas remeasured";
warnmess "--------------------------------";
}
copy($comp, $comp."b");
#system "rm -f $comp"."b";
#system "cp $comp $comp"."b";  #create back copy even if no processing this time
# Display the graph of the component
if ($Goption) {
   warnmess "Graphing component..."; 
   system "perl Xcute $comp";
}
close COMP;
close COMPTH unless $ccftsExist;
close OLDTH if $incrproc;
} #end loop over components

#Create "ident" ccft file and conduction matrix
  open (I, ">ident.ccft");
  if ($Foption) { #reliability
    print I "theory LC r 99\n";
    print I "-1000000 1000000 1 0 0 1\n";  #[-10^6,10^6), slope 1, intercept 0, reliability 1, no error
  } else { #run time
    print I "theory L \n";
    print I "-1000000 1000000 1 0 0 0\n";  #[-10^6,10^6), slope 1, intercept 0, 0 run time, no error
  }
  close(I);
open (I, "> ident.cm");
print I "ident\n";
close(I);
open (I, "> ident-ident.cm");
print I "1\n";
close(I);

