#!/usr/bin/perl -w
#
# XS [options] [perl] Code [Subd] instart stop count [ststart stop count]
#
#  Runs executable Code using range(s) given.
#   "perl" before Code runs with Perl
#
#  Optional Subd is a file like .ccf that has subdomains; if present
#    sort into subdomain order, and preceed output lines with pairs
#    of subdomain indices
#    
#   -R option needs only first range; -U requires both
#
#  An output file is created for others to use, named "measured.dat"
#    with line format:
#      1st line:  "state/concurrent" "R/U" initial-state in-range st-range 
#      other lines:
#      [inindex stindex] input instate output runtime outstate  (for state)
#      [inindex stindex] input inparallel output runtime1 outparallel runtime3 runtime4 (for concurrent)
#    sorted on fields:  [2,1],3

use component;
use sampling;
use status;

########################################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...
}
#######################################################################

#print "@ARGV (to XS)\n";  #debug

$QQoption = 0; #last unknown...
$Voption = 0;  #verbose
$Roption = 1;  #sequence sampling
$concurrent = 0;  
$hw = -1; #last "-" arg
for ($opt=0; defined($ARGV[$opt]); $opt++) {
  if ($ARGV[$opt] eq "-V") {
    $Voption = 1;
    $hw = $opt;
  } elsif ($ARGV[$opt] eq "-R") {
    $Roption = 1;
    $hw = $opt;
  } elsif ($ARGV[$opt] eq "-U") {
    $Roption = 0;
    $hw = $opt;
  } elsif ($ARGV[$opt] eq "-P") {
    $concurrent = 1;
    $hw = $opt;
  # skip "-ALPHA" pattern
  } elsif (substr($ARGV[$opt],0,1) eq "-" && substr($ARGV[$opt],1,1) =~ /\p{IsLu}/) {
    $QQoption = substr($ARGV[$opt],1); #save last unknown option
    $hw = $opt;
  }
}
die "A code file to execute must be given" unless (defined($ARGV[$hw+1]));
if ($ARGV[$hw+1] eq "perl") { 
  $hw++;
  die "A code file to execute must be given" unless (defined($ARGV[$hw+1]));
} 
$code_name = $ARGV[$hw+1];
die "given file ",$code_name," not found" unless (-e $code_name);
$hasubd = 0;  #assume no subdomain file
$maysub = $ARGV[$hw+2];
if (defined($maysub) && substr($maysub,0,1) =~ /\p{IsAlpha}/) { #starts with a letter
  die "the subdomain-list file $maysub is missing" unless (-e $maysub);
  $hasubd = 1;
  $hw++;
}

if ($hasubd) { #get subdomain info before measuring
  open(SBD, "<$maysub");
  $line = <SBD>;  #skip a header line
  $line_count = 0;
  $inCount = 0;
  $stCount = 0;
  $blankline = 0;
  while ($line = <SBD>) { #read subdomains
    @linesplt = split(' ',$line);
    if ($line eq "\n") {
      $blankline = 1;
      $leftin = $inLB[0];
      $rightin = $inUB[$line_count-1];
      $line_count = 0;
    }
    else {
      die "subdomain file $maysub seems to have bad format..." if ($linesplt[0] >= $linesplt[1]); 
      if ($blankline) { #seen, doing states
        $stLB[$line_count] = $linesplt[0];
        $stUB[$line_count] = $linesplt[1];
        $stCount += $linesplt[2];
      } else { #inputs
        $inLB[$line_count] = $linesplt[0];
        $inUB[$line_count] = $linesplt[1];
        $inCount += $linesplt[2];
      }
      $line_count++;
    }
  }
  $leftst = $stLB[0];
  $rightst = $stUB[$line_count-1];
#print "inUBs: @inUB\n";  #debug
  close SBD;
} 
if (defined($ARGV[$hw+2])) { #override range from command line
#print "$ARGV[$hw+4] (count)\n";  #debug
  die "first three range/count arguments must be given" unless (defined($ARGV[$hw+4]));
  $leftin = $ARGV[$hw+2];
  $rightin = $ARGV[$hw+3];
  $inCount = $ARGV[$hw+4];
  unless ($Roption) {
    die "second three range/count arguments must be given" unless (defined($ARGV[$hw+7]));
    $leftst = $ARGV[$hw+5];
    $rightst = $ARGV[$hw+6];
    $stCount = $ARGV[$hw+7];
  }
} 
#measure file, make "measured.dat"

$compExecut = $code_name;
$input_start = $leftin;
$input_end = $rightin;
$input_freq = $inCount;
$state_freq = $stCount;
$seq_count = $inCount;

unlink glob("*.state");  #make sure no state files exist
if ($Roption) {
  if ($Voption) { &status::init($seq_count, "Sampling ".$compExecut
              ." in [".$input_start.",".$input_end.") for ".$seq_count." sequences");} 
} else {
#print "$input_freq x $state_freq subdomains\n";  #debug
  if ($concurrent) {
    $called = "concurrent inputs";
  } else {
    $called = "states";
  }
  if ($Voption) { &status::init($input_freq * $state_freq, "Sampling subdomains of $compExecut "
           ."$input_freq inputs x $state_freq $called"); }
}

$compObj = component->new(component => $compExecut);
$compObj -> run(($input_start + $input_end)/2);
chomp($InitialState = $compObj->getState);

# Prepare input sampling

$count = 0;
#@inputs = ();
#@in_state = ();
#@outputs = ();
#@runtimes = ();
#@out_state = ();
$test_point_count = 0;

open(DAT, ">measured.dat");
#die "$compExecut file to be executed";  #debug
if ($Roption) { #random and hence state, not concurrent
  print DAT "state R $InitialState $compExecut $input_start $input_end $seq_count\n";
  srand(3.14159265); #we want the same sequence every time this runs
  # Loop through input sequences
  #state initialized above
  for $i (1..$seq_count) {
    $input_freq = int(rand($seq_count)) + 1;
    $test_point_count += $input_freq;
    $input_sampler = sampling->randomize($input_start, $input_end, $input_freq);
    $compObj = component->new(component => $compExecut);
    # Loop through input
    $input = $input_sampler->next();
#print "Input sequence # $i\n"; #debug
    $state = $InitialState;
    while ($input !~ /^\.$/) {
      #$inputs[$count] = $input; # Record starting values
      #$in_state[$count] = $state;
#print "$input $in_state[$count] \n"; #debug
      print DAT "$input $state ";
    # Run component
      $compObj->run($input,$state) || die "Cannot run component";
      $theout = $compObj->getOutput;
#print "$theout\n"; #debug
      #$outputs[$count] = $theout;
      $therun = $compObj->getRuntime;
      #$runtimes[$count] = $compObj->getRuntime;
     # Get persistent state
      chomp($state = $compObj->getState);
      #$out_state[$count] = $state;
#print "$out_state[$count]"; die "...that's one";  #debug
      print DAT "$theout $therun $state\n";
      #$count++;
      $input = $input_sampler->next();
    } # Next input
#print "seq ctr: $count \n";  #debug
    if ($Voption) { &status::progress($i); }
  } # Next input sequence
  if ($Voption) { print "\n";} #can't use warn: buffers
  warnmess "Sampled $seq_count sequences, $test_point_count points.";
} else { #systematic sampling
  #collect the lists of inputs/states to use
  &sampling::init($leftin,$rightin,$inCount);
  $numin = 0;
  while (($input = &sampling::next) ne ".") {
    $Ins[$numin++] = $input;
  }
  &sampling::init($leftst,$rightst,$stCount);
  $numst = 0;
  while (($input = &sampling::next) ne ".") {
    $Sts[$numst++] = $input;
  }
#print "ranges: $leftin $rightin $inCount  $leftst $rightst $stCount\n";  #debug
  $statecurr = "state";
  if ($concurrent) {
    $statecurr = "concurrent";
  }
  print DAT "$statecurr U $InitialState $compExecut $leftin $rightin $inCount $leftst $rightst $stCount\n";
#print "ins: @Ins\nsts: @Sts\n";  #debug
  for ($i=0; $i<$numst; $i++) { #loop over states
    $state = $Sts[$i];
    for ($j=0; $j<$numin; $j++) { #loop over inputs
      $input = $Ins[$j];
      # Record initial values
      #$inputs[$count] = $input;
      #$in_state[$count] = $state;
      #$in_subd[$count] = $ii;
      #$st_subd[$count] = $is;
      print DAT "$input $state ";
      # Run component
      if ($concurrent) { #"states" are 2nd input from parallel component
        ($out2,$run1) = component::start($input,$compExecut,0);
        #$outputs2[$count] = $out2;
        #$runtimes[$count] = $run1;
        ($output,$run3,$run4) = component::finish($state,0);
        #$outputs[$count] = $output
        #$runtimes3[$count] = $run3;
        #$runtimes4[$count] = $run4;
        print DAT "$output $run1 $out2 $run3 $run4\n";
      } else { #state
        #new() not needed, done for init above
        #$compObj = component->new(component => $compExecut);
        $compObj->run($input, $state) || die "Cannot run component";
        $output = $compObj->getOutput;
        #$outputs[$count] = $compObj->getOutput;
        $runtime = $compObj->getRuntime;
        #$runtimes[$count] = $compObj->getRuntime;
        # Get persistent state
        #$out_state[$count] = $compObj->getState;
        $restate = $compObj->getState;
        print DAT "$output $runtime $restate\n";
      }
      $count++;
    } #end loop over inputs
    if ($Voption) { &status::progress($count); }
  } #end loop over states
  $prod = $input_freq*$state_freq;
  #$n_subs = $NumInSubd*$NumStSubd[0];
  if ($Voption) { print "\n";} #can't use warn: buffers
  warnmess "Sampled input domain $input_freq times, state $state_freq times, $prod points.";
} #end two kinds sampling
close DAT;

unless ($concurrent) {
  $compObj->NoState; #kill FIFO file now that it's done
}

if ($hasubd) { #sort file if there are subdomains

  open (DAT, "<measured.dat") or die "Measurement file measured.dat has disappeared!";
  $head = <DAT>;  #save head line
  $k = 0;
  while ($rec = <DAT>) {
    @recf = split(' ',$rec);
    $temporder1[$k] = "$k $recf[0] $recf[1]";
    chomp($data[$k++] = $rec);
  }
  close DAT;
#print "$k ?= $count data records\n";  #debug
  $count = $k;
  #sort indices into subdomain order in @indexorder
  @temporder2 = sort {@af = split(' ',$a); @bf = split(' ',$b); $af[1] <=> $bf[1]} @temporder1;
  $i = 0;  #index in input subdomains
  for ($k=0; $k<$count; $k++) {
    @breakout = split(' ',$temporder2[$k]);
    if ($breakout[1] >= $inUB[$i]) {
      while ($breakout[1] >= $inUB[$i]) {  #skip empty subdomains
        $i++
      }
    }
    $breakout[3] = $i;
    $temporder2[$k] = join(' ',@breakout);
  }
  @temporder1 = sort {@af = split(' ',$a); @bf = split(' ',$b); $af[2] <=> $bf[2]} @temporder2;
  $i = 0;  #index in state subdomains
  for ($k=0; $k<$count; $k++) {
    @breakout = split(' ',$temporder1[$k]);
    if ($breakout[2] >= $stUB[$i]) {
      while ($breakout[2] >= $stUB[$i]) {  #skip empty subdomains
        $i++
      }
    }
    $breakout[4] = $i;
    $temporder1[$k] = join(' ',@breakout);
  }
#for ($k=0; $k<100; $k++) { print "$temporder1[$k]\n"; }  die "stopped"; #debug

#final sort
  @temporder2 = sort {@af = split(' ',$a); @bf = split(' ',$b); $af[4] <=> $bf[4] 
     || $af[3] <=> $bf[3] || $af[1] <=> $bf[1]} @temporder1;
#for ($k=0; $k<100; $k++) { print "$temporder2[$k]\n"; }  #debug
  $lastreal = 0;
  for ($k=0; $k<$count; $k++) {
    @tl = split(' ',$temporder2[$k]);
    $realk = $tl[0];
    $grids[$realk] = 0;
    if ($k == 0 || $isub != $tl[3] || $ssub != $tl[4]) {
      if ($k !=0) { # grid lines for contour plots
        if ($isub != $tl[3] && $ssub != $tl[4]) { #both changed: grid line data block
          $grids[$lastreal] = 1;
#print "grid 1 at $k/$tl[0]\n";  #debug
          if ($tl[4] > $ssub+1) { #disconnected block
            $grids[$lastreal] = 2;
#print "grid 2 at $k/$tl[0]\n";  #debug
          }
        }
      }
      $isub = $tl[3];
      $ssub = $tl[4];
    }
    $in_subd[$realk] = $isub;
    $st_subd[$realk] = $ssub;
    $indexorder[$k] = $realk;
    $lastreal = $realk;
  }
  open(DAT,">measured.dat"); #rewrite file with subdomains in front
  print DAT "$head";
  foreach $k (@indexorder) {
    print DAT "$in_subd[$k] $st_subd[$k] $data[$k] $grids[$k]\n";
  }
  close DAT;
}
