#! /usr/bin/perl -w
# profile [-S] <file1> 
#  
#   Plots a histogram profile from the trace for component file1.ccf
#    and if there is a trace_report.th plots that also.
#    Also plots calculated (e.g.) theory2-file1.cm if available
#    The "theory" name and system subdomains are obtained from system.scf
#    Plot files created:  profile.plt for measured; profile2.plt for .th; profile3.plt for .cm
#     profile4.plt for smoothed version of .cm
#    Subdomains are shown on the x-axis as [a,b) (rotated), if -S option,
#     otherwise plots just numerical scale
#    The width of histogram bars is subdomain width
#  With state, only one measured plot (as yet), showing only those
#    subdomains feasible in .ccfc file for the component.

use util;

$discrete = 0;
if (defined($ARGV[0]) && ($ARGV[0] eq "-S")) {
  $discrete = 1;
}
die "Must give comp(w/o .ccf) file name" unless (defined($ARGV[$discrete]) && -e "$ARGV[$discrete].ccf");
$bare = $ARGV[$discrete];
$ccfile = "$bare.ccf";
$ccfcfile = "$bare.ccfc";

#################################################################
sub bar { #move and size print bars
  #parameters are left,right,top of bar
  my($L, $R, $top);
  $L = $_[0];
  $R = $_[1];
  $top = $_[2];
  #print "$L $R $top\n"; #debug
  if ($discrete) { #same-size bars with labels
    $E = $B + $barwid;
    $lab = sprintf '"[%.1f, %.1f)"',$L,$R;
    $pos = $B + $shift/2 -$del;
    print CP "set label $lab at $pos,-.01 right rotate\n";
  } else { #bar width is same as subd
    $shrink = ($R - $L)/13;
    if ($bar2) { #displace a 2nd set of bars
      $L += $shrink/2;
      $R += $shrink/2;
    }
    $B = $L+$shrink;
    $E = $R-$shrink;
  }
  print PLT "$B 0\n";
  print PLT "$B $top\n";
  print PLT "$E $top\n";
  print PLT "$E 0\n";
  print PLT "\n";  #no connection between bars
  $B += $shift;  #setup for next bar (not used if numerical scale...)
  return 
}

#################################################################
sub process {
LINE: while ($line = <TRA>) {
  chop($line);
  @spread = split(" ", $line);
  #print "@spread \n";  #debug
  $stateless = 1;
  FIELD: for ($i=0;;$i++) {
    if (not defined($spread[$i])) {
      next LINE;
    }
    #print "$spread[$i]\n";  #debug
    if ($spread[$i] eq $ccfile) { #found, jump out
      if (defined($spread[$i+1]) && $spread[$i+1] eq "w/state") { #with state
      $stateless = 0;
      }
      last FIELD;
    }
  }
  #data down to blank line or EOF
  $line = <TRA>; #skip first blank line
  $k = 0;
  $tot_hits = 0;
  DAT: 
  while ($line = <TRA>) {
#print "Input: $line";
    chop($line);
    if ($line eq "") { #blank line
      last DAT;
    }
    if ($stateless) {
      #format is:  [n, m) c
      @spread = split(/,|\ |\[|\)|	/, $line);
    #print "@spread \n";  #debug
      #@spread0 = split(' ',$compSubd[$k]); #these, not trace file, should control (not needed?)
      $left[$k] = $spread[1]; 
      $right[$k] = $spread[3]; 
      $hits[$k] = $spread[5];
      #if ($spread0 < $left[$k]) { #subdomain never hit in measured trace--not needed?
        #$left[$k] = $spread0[0];
        #$right[$k] = $spread0[1];
        #$hits[$k] = 0;
      #}
      $tot_hits += $hits[$k];
      $k++;
    } else { #w/state
      #format:  input [n, m) states:
      #         [tab][p, q) c
      @spread = split(/,|\ |\[|\)|	/, $line);
#print "1:|$spread[1]|, 2:|$spread[2]|, 3:|$spread[3]| ...\n";  #debug
      $leftin[$k] = $spread[2];
      $rightin[$k] = $spread[4];
      $p = 0;
      MDAT:
      while ($line = <TRA>) { #go through state lines
#print "State: $line"; #debug
        chomp($line);
        if ($line eq "") { #end of state block
          last MDAT;
        }
        @spread = split(/,|\ |\[|\)|      /, $line);
#print "1:|$spread[1]|, 2:|$spread[2]|, 3:|$spread[3] ...\n";  #debug
        $leftst[$p] = $spread[1];
        $rightst[$p] = $spread[3];
        $hits[$k][$p] = $spread[5];
        $tot_hits += $spread[5];
        $p++;
      }
      $k++;
      $num_st_subs = $p;  #same for each input block
#print "st cnt: $p; in ct: $k\n";  #debug
    }
  }
  $num_sub = $k;
  #print "$tot_hits\n";  #debug
  if ($stateless) {
    for ($i=0; $i < $num_sub; $i++) {
      if ($tot_hits > 0) {
        $hits[$i] /= $tot_hits;
      } #else $hits[] also 0
      #print "$hits[$i]\n";  #debug
      bar($left[$i], $right[$i], $hits[$i]);
    }
  } else { #state
    #use feasible counts from .ccfc file
    $feas = 0;
    if (open (CCFC, "<$ccfcfile")) { #do nothing if no file
      $feas = 1;
      $line = <CCFC>; #header line
      for ($i=0; $i<$num_sub+$num_st_subs; $i++) {
        $line = <CCFC>;  #skip subdomains info
      }
      #positioned at data
    }
    #barbar
    for ($j=0; $j<$num_st_subs; $j++) { #states first to match .ccfc data
      $L = $leftst[$j];
      $R = $rightst[$j];
      for ($i=0; $i<$num_sub; $i++) { #input loop
        if ($feas) {
          $line = <CCFC>;
          @lane = split(' ',$line);
          $feasub[$i][$j] = $lane[0];  #count of executions from comp meas
        }
        if ($tot_hits > 0) {
          $hits[$i][$j] /= $tot_hits;
        }
      } # end first pass thru inputs
      for ($i=0; $i<$num_sub; $i++) { #input loop to plot zero grid 
        if (!$feas || $feasub[$i][$j] > 0) { #plot only feasible bars
          $l = $leftin[$i];
          $r = $rightin[$i];
          print PLT "$l $L 0\n";
          print PLT "$l $L 0\n"; #dup to match count of bar data
          print PLT "$r $L 0\n";
          print PLT "$r $L 0\n"; #dup to match count of bar data
        }
      }
      print PLT "\n"; #grid sep
      for ($i=0; $i<$num_sub; $i++) { #input loop to plot bars 
        if (!$feas || $feasub[$i][$j] > 0) { #plot only feasible bars
          $h = $hits[$i][$j];
          $l = $leftin[$i];
          $r = $rightin[$i];
          print PLT "$l $L 0\n";
          print PLT "$l $L $h\n";
          print PLT "$r $L $h\n";
          print PLT "$r $L 0\n";
        }
      }
      print PLT "\n"; #grid sep
      for ($i=0; $i<$num_sub; $i++) { #input loop to plot bars 
        if (!$feas || $feasub[$i][$j] > 0) { #plot only feasible bars
          $h = $hits[$i][$j];
          $l = $leftin[$i];
          $r = $rightin[$i];
          print PLT "$l $R 0\n";
          print PLT "$l $R $h\n";
          print PLT "$r $R $h\n";
          print PLT "$r $R 0\n";
        }
      }
      print PLT "\n";  #grid
      for ($i=0; $i<$num_sub; $i++) { #input loop to plot zero grid
        if (!$feas || $feasub[$i][$j] > 0) { #plot only feasible bars
          $l = $leftin[$i];
          $r = $rightin[$i];
          print PLT "$l $R 0\n";
          print PLT "$l $R 0\n"; #dup to match count of bar data
          print PLT "$r $R 0\n";
          print PLT "$r $R 0\n"; #dup to match count of bar data
        }
      }
      print PLT "\n\n";
    }
    if ($feas) {
      close CCFC;
    }
  }
  return;
}
die "couldn't find profile for ",$ccfile;
}
#################################################################

$norm = 0;
$uniform = 0;
if (-e "system.scf") { # use weights later?
  $norm = 1;
  open (SCF,"< system.scf"); 
  $k = 0;
  chomp($line = <SCF>);  #first has 'theory' name
  @sline = split('\.',$line);
  $thname = $sline[0];
#print "thname:  |$thname|\n";  #debug
  while ($line = <SCF>) {
    @fields = split(' ',$line);
    $sysSubd[$k] = $line;
    if ($k == 0) {  #first line
      if (defined($fields[3])) { #weighted TBD later
        warn "system.scf weights not yet implemented...";
      } else { #use uniform weighting
        $uniform = 1;
        warn "Using uniform subdomain weighting";
      }
    }
    $k++;
  }
  close(SCF);
} else {
die "No system.scf file";
}
open(CCF,"< $ccfile");  #exists from above
$k = 0;
chomp($line = <CCF>);  #first has code file name
while ($line = <CCF>) {
  @fields = split(' ',$line);
  $compSubd[$k] = $line;
  if ($k == 0) {  #first line
    $Left = $fields[0];
  }
  $k++;
}
close(SCF);
$Right = $fields[1];
$domainwid = $Right - $Left;
$numSubd = $k;
#print "domain width: $domainwid with $numSubd subdomains\n";  #debug

  $barwid = 0.86*$domainwid/$numSubd;
  $del = $barwid/7; #gap between bars
  $shift = $barwid + $del;
  open (PLT, ">profile.plt") or die "Can't open plotting file";
  $B = 0;
  open (TRA, "trace_report") or die "Can't locate trace data file";
  open (CP, ">complot") or die "can't create plot control file";
  $bar2 = 0; #first set of bars
  process();
  close (CP);
  close(TRA);
  close(PLT);
  $ccfile2 = 0;
  $ccfile2 = 1 if (-e "trace_report.th");
  if ($ccfile2) {
    open (CP,">/dev/null");
    open (TRA, "trace_report.th");
    open (PLT, ">profile2.plt") or die "Can't open plotting file";
    $B = $del/2;
    $bar2 = 1; #second set of bars
    process();
    close(CP);
    close(TRA);
    close(PLT);
  } else {
    #warn "Table-lookup approximation omitted--no file trace_report.th";
  }
    $cmfile = "$thname-$bare.cm";
    $cmfile3 = 0;
    if (-e $cmfile) {
      $cmfile3 = 1;  #flag for testing
      open (CM, "< $cmfile");
      open (PLT, ">profile3.plt") || die "Can't open plotting file";
      open (PLTS, ">profile4.plt") || die "Can't open plotting file";
      $k = 0;
      $totalfrac = 0;
      while ($cmline = <CM>) {
        @cmvals = split(' ',$cmline);
        if ($k == 0) { #first line
          for ($i=0; defined($cmvals[$i]); $i++) {
            $cmtot[$i] = 0;
          }
          $nsubs = $i;
        }
        $line = $sysSubd[$k];
#print "system.scf line: $line\n";  #debug
        @control = split(' ',$line);
        $left = $control[0];
        $right = $control[1];
        $frac = ($right-$left)/$domainwid;
        for ($i=0; $i<$nsubs; $i++) {
          $cmtot[$i] += $cmvals[$i]*$frac;
        }
      $k++;
      }
      close(CM);
      $totalfrac = 0;
      for ($i=0; $i<$nsubs; $i++) {
        $totalfrac += $cmtot[$i];
      }
      if ($totalfrac == 0) { #nothing reached here
        $adjust = 0;  #plot all zeroes
      } else {
        $adjust = 1/$totalfrac;
      }
      $npts = 2;
      for ($i=0; $i<$nsubs; $i++) {
        if ($discrete) {
          $barc = $i*($barwid+$del) + $ccfile2*$del/2 + $barwid/2;
        } else { #use data from .ccf file, saved above
          @spread = split(' ',$compSubd[$i]);
          $barwid = $spread[1] - $spread[0];
          $barc = ($spread[0] + $spread[1])/2.0
        }
        $barht = $adjust*$cmtot[$i];
        if ($i != 0) { #interpolate wrt previous
          $x1 = $prevbarc - $barwid/4;
          $x2 = $prevbarc + $barwid/4;
          print PLTS "$x1 $prevbarht\n";
          print PLTS "$x2 $prevbarht\n";
          for ($j=1; $j<$npts; $j++) { 
            $deltax = ($barc - $prevbarc)/$npts;
            $deltay = ($barht - $prevbarht)/$npts;
            $x = $prevbarc + $deltax*$j;
            $y = $prevbarht + $deltay*$j;
            print PLTS "$x $y\n";
          }
        }
        $prevbarc = $barc;
        $prevbarht = $barht;
        if ($ccfile2) { #there was table-lookup, plot points for prediction
          print PLT "$barc $barht\n";
        } else { #plot bars for prediction
          $bar2 = 1;
          if ($discrete) { #could use bar()?
            $barc += $del/2;
            $lbar = $barc - $barwid/2;
            $rbar = $barc + $barwid/2;
            print PLT "\n";
            print PLT "$lbar 0\n";
            print PLT "$lbar $barht\n";
            print PLT "$rbar $barht\n";
            print PLT "$rbar 0\n";
          } else {
            bar($spread[0],$spread[1],$barht);
          }
        }
      } 
      close (CM);
      close (PLT);
      close (PLTS)
    } else {
      warn "Prediction omitted--can't find file $cmfile";
    }
  open(PF,">>complot");
  #print PF "set terminal postscript color\n";
  #print PF qq(set output "plot.ps"\n);
  print PF qq(set border 2\n) if ($stateless);
  print PF qq(set offsets .01\n);
  print PF qq(set bmargin 8\n) if ($discrete && $stateless);
  print PF qq(set tics out\n);
  print PF qq(set xlabel "Input subdomains of component $bare"\n);
  print PF qq(set ylabel "Relative frequency"\n);
  print PF qq(set ytics nomirror\n);
  print PF qq(set noxtics\n) if ($discrete);
  if ($stateless) {
    if ($ccfile2 || $cmfile3) { #needs label
      print PF qq(plot "profile.plt" title "measured" with lines lt -1);
    } else {
      print PF qq(plot "profile.plt" notitle with lines lt -1);
    }
    if ($ccfile2) {
      print PF qq(, "profile2.plt" title "table-lookup" with lines lt 1);
    }
    if ($cmfile3) {
      if ($ccfile2) {
        print PF qq(, "profile3.plt" title "prediction" with points); 
      } else {
        print PF qq(, "profile3.plt" title "prediction" with lines lt 1); 
      }
      # smoothed prediction curve
      print PF qq(, "profile4.plt" title "smoothed prediction" smooth csplines); 
    }
    print PF "\n";
  } else { #with state
    print PF qq(set ylabel "State subdomains"\n);
    print PF qq(set zlabel "Relative frequency"\n);
    print PF qq(set hidden3d\n);
    print PF qq(splot "profile.plt" with lines \n);
  }
  #print PF "pause -1\n";
  close(PF);
  util::GNUplotit("complot");
  #system("gnuplot complot");
