#!/usr/local/bin/perl

$alpha = 0.5;

@funcname = qw(gramm formfunc topic misc);

&main;
sub main {
  &initvars;
  while (<>) {
    if (/^\< ((\d+ )+)\>$/) {
      @_ = split /\s/;
  #print join ";;", @_;
      shift eq '<';
      $totalMap += shift; #total constituents in MAP parse
      $obviousMap += shift; #obvious consts in MAP parse, i.e. the S1 node
      $correctMap += shift; #correct consts of MAP parse
      $totalPrecision += shift; #total constituents in the correct parse
      $obviousPrecision += shift; #obvious consts of correct parse, i.e. terms;
				     #also S1
      $correctPrecision += shift;
      $totalExact += shift;
      $ignoredExact += shift;
      $exactMap += shift;
      $exactPrecision += shift;
      $otherWrong += shift;
      $complementPrecision += shift;
      for my $func (0..3) {
	$funcTagPrecisionA[$func] += shift;
	$funcTagPrecisionB[$func] += shift;
	$funcTagPrecisionC[$func] += shift;
	$funcTagPrecisionD[$func] += shift;
	$funcTagPrecisionE[$func] += shift;
      }
      shift eq '>';
      ++$sent;
    } elsif (/^Parsing time/) {
      /Edges created = (\d+)\s+Edges popp?ed = (\d+) \((\d+) (\d+\.\d+)/
	  or
      /Edges created = (\d+)\s+Edges popp?ed = (\d+) \/\d+\s+\((\d+) (\d+\.\d+)/;
      $edgesCreated += $1;
      $edgesPopped += $2;
      $sentLength += $3;
      $firstParse += $4 * ($3 * 1.8) + $3;

      $sent2++;
    } elsif (/topS\!/ || /xalloc/) {
      $unparsed++;
    } elsif (/^\d+\.\d+u/) {
      $time = $_;
    }
    break if eof;
  } continue {
    if (eof) {
      &printstats;
      &initvars;
    }
  } #end while <>
} #end main

sub printstats {
  if ($debug) {
    print "< ";
    print $totalMap, " ";
    print $obviousMap, " ";
    print $correctMap, " ";
    print $totalPrecision, " ";
    print $obviousPrecision, " ";
    print $correctPrecision, " ";
    print $totalExact, " ";
    print $ignoredExact, " ";
    print $exactMap, " ";
    print $exactPrecision, " ";
    print $otherWrong, " ";
    print $complementPrecision, " ";
    for my $func (0..3) {
      print "\n  ";
      print $funcTagPrecisionA[$func], " ";
      print $funcTagPrecisionB[$func], " ";
      print $funcTagPrecisionC[$func], " ";
      print $funcTagPrecisionD[$func], " ";
      print $funcTagPrecisionE[$func], " ";
    }
    print ">\n";
  }

  $sent > 0 or die "No sentences parsed.\n";

  #afaict recall is correctMap/totalPrecision, and precision is
  #correctMap/totalMap.  So:
  $recall = eval { $correctPrecision/$totalExact } || "NaN";
  $precision = eval { $correctPrecision/$totalPrecision } || "NaN";
  $accuracy = eval { ($correctMap - $obviousMap) /
    ($totalMap - $obviousMap); } || "NaN";
  $labelledPrecision = eval { $exactPrecision / $totalPrecision; } || "NaN";
  $labelledRecall = eval { $exactPrecision / $totalExact; } || "NaN";
  $complementedPrecision = eval { $complementPrecision / $totalPrecision; } || "NaN";
  $complementedRecall = eval { $complementPrecision / $totalExact; } || "NaN";
  $adjLabelledRecall = eval { $otherWrong / $totalExact; } || "NaN"; # ???
  $adjLabelledPrecision = eval { $otherWrong / $totalPrecision; } || "NaN"; # ???

  print "$sent sentences; $unparsed unparsed\n";

  #print "Average sentence length: ", $sentLength/$sent2, "\n";
  print "\nEdges---";
  print "  at first parse: ", $firstParse/$sent;
  print "  created: ", $edgesCreated/$sent;
  print "  popped: ", $edgesPopped/$sent;
  print "\n";

  print "\nParsing.\n";
  print "  Bracketed   ", stringPRF ($precision, $recall), "\n";
  print "  Labelled    ",
	  stringPRF ($labelledPrecision, $labelledRecall), "\n";
  print "  Adjusted labelled ",
	  stringPRF ($adjLabelledPrecision, $adjLabelledRecall), "\n";

  print "\nFunction tags.";
  print "\n  C  ",
	  stringPRF($complementedPrecision, $complementedRecall), "\n\n";

  for my $func (0..3) {
    if ($funcTagPrecisionB[$func] == 0 && $funcTagPrecisionC[$func] == 0) {
      $funcTaggedPrecision = $funcTagPrecisionA[$func] / $totalPrecision;
      $funcTaggedRecall = $funcTagPrecisionA[$func] / $totalExact;
    } elsif ($funcTagPrecisionC[$func] == 0) {
      $funcTaggedPrecision = 0;
      $funcTaggedRecall = 0;
      $funcTaggedAccuracy = 
	($funcTagPrecisionC[$func] + $funcTagPrecisionA[$func]) /
	($funcTagPrecisionC[$func] + $funcTagPrecisionD[$func] + 
	  $funcTagPrecisionB[$func] + $funcTagPrecisionA[$func] + 
	  $funcTagPrecisionE[$func]);
    } else {
      $funcTaggedPrecision = $funcTagPrecisionC[$func] / 
	($funcTagPrecisionC[$func] + $funcTagPrecisionD[$func] + 
	  $funcTagPrecisionE[$func]);
      $funcTaggedRecall = $funcTagPrecisionC[$func] /
	($funcTagPrecisionC[$func] + $funcTagPrecisionD[$func] + 
	  $funcTagPrecisionB[$func]);
      $funcTaggedAccuracy = 
	($funcTagPrecisionC[$func] + $funcTagPrecisionA[$func]) /
	($funcTagPrecisionC[$func] + $funcTagPrecisionD[$func] + 
	  $funcTagPrecisionB[$func] + $funcTagPrecisionA[$func] + 
	  $funcTagPrecisionE[$func]);
    }

if (0)
{ local $, = "--";
  print $funcTagPrecisionA[$func],
	$funcTagPrecisionB[$func],
	$funcTagPrecisionC[$func],
	$funcTagPrecisionD[$func],
	$funcTagPrecisionE[$func], "\n";
}
    
    print "  ", uc substr($funcname[$func], 0, 1),
	  "  A: ", perc($funcTaggedAccuracy),
	  "  ", stringPRF($funcTaggedPrecision, $funcTaggedRecall),
	  "\n";
  }

  my $A = $funcTagPrecisionA[0] + $funcTagPrecisionA[1]
	+ $funcTagPrecisionA[2] + $funcTagPrecisionA[3];
  my $B = $funcTagPrecisionB[0] + $funcTagPrecisionB[1]
	+ $funcTagPrecisionB[2] + $funcTagPrecisionB[3];
  my $C = $funcTagPrecisionC[0] + $funcTagPrecisionC[1]
	+ $funcTagPrecisionC[2] + $funcTagPrecisionC[3];
  my $D = $funcTagPrecisionD[0] + $funcTagPrecisionD[1]
	+ $funcTagPrecisionD[2] + $funcTagPrecisionD[3];
  my $E = $funcTagPrecisionE[0] + $funcTagPrecisionE[1]
	+ $funcTagPrecisionE[2] + $funcTagPrecisionE[3];

      $funcTaggedPrecision = eval { $C / ($C + $D + $E) } or 0;
      $funcTaggedRecall = eval { $C / ($C + $D + $B) } or 0;
      $funcTaggedAccuracy = eval { ($A + $C) / ($A + $B + $C + $D + $E);} or 0;
      print "\n", $C + $D + $B, "   ", $C + $D + $E, "\n\n" if $debug;
      
    print "\n avg A: ",
	  perc($funcTaggedAccuracy), "  ",
	  stringPRF ($funcTaggedPrecision, $funcTaggedRecall), "\n";

  #  print "All correctly labelled constits: ",
  #  	($A + $B + $C + $D + $E), " ", $otherWrong*4, "\n";

  #  print "\nNOTE: the following numbers are for res014 only:";
  #  print "\nAverage functag all-withnull",
  #  	"  P: ", perc(($A+$C)/(4*$totalPrecision)),
  #  	"  R: ", perc(($A+$C)/(4*$totalExact)), "\n";
  #  print "Average functag all-nonull ",
  #  	"  P: ", perc($C/8643),
  #	"  R: ", perc($C/10117), "\n";

    if ($time) {
      print "\nTime: $time\n" ;# if $time;
    } else {
      print "\n\n";
    }

} #end printstats

sub initvars {
  print "Stats on " . $ARGV[0] . '='x55 . "\n\n" if @ARGV;

  $precision = $recall = 0.0;
  $sent = 0;
  $sent2 = 0;
  $unparsed = 0;

  $totalMap = 0;
  $obviousMap = 0;
  $correctMap = 0;
  $totalPrecision = 0;
  $obviousPrecision = 0;
  $correctPrecision = 0;
  $totalExact = 0;
  $ignoredExact = 0;
  $exactMap = 0;
  $exactPrecision = 0;
  $otherWrong = 0;
  $complementPrecision = 0;
  for my $func (0..3) {
    $funcTagPrecisionA[$func] = 0;
    $funcTagPrecisionB[$func] = 0;
    $funcTagPrecisionC[$func] = 0;
    $funcTagPrecisionD[$func] = 0;
    $funcTagPrecisionE[$func] = 0;
  }
}

sub perc {
  $num = shift;
  sprintf "%5.3f\%", $num * 100;
}

sub stringPRF {
  my $prec = shift;
  my $rec = shift;
  return
    "P: " . perc($prec) . "  " .
    "R: " . perc($rec) . "  " .
    "P+R/2: " . perc(($prec + $rec)/2) . "  " .
    "F: " .
      (eval { perc((1 / ($alpha / $prec + (1 - $alpha) / $rec))) }
       || "NaN");
}
