#!/usr/bin/env perl
# reads stdin as three tab-delimited columns:
#   candidate alignments
#   manual sure alignments
#   manual possible alignments
# emits alignment error rate, precision and recall
#   precision = |A∩P| / |A|
#   recall = |A∩S| / |S|
#   AER = 1 - (|A∩S| + |A∩P|) / (|A| + |S|)
# the averaging is across all the sentences

use strict;

my $debug = 0;

my $counts;
my $nr = 0;
while (<>) {
  $nr++;
  chomp;
  my ($cand, $sure, $poss) = split /\t/;
  my $str;
  $str->{"cand"} = $cand;
  $str->{"sure"} = $sure;
  $str->{"onlyposs"} = $poss;
  my $data;
  foreach my $type (qw(cand sure onlyposs)) {
    die "$nr:Missing $type alignments" if !defined $str->{$type};
    my %set = map { ($_, 1) } split / /, $str->{$type};
    foreach my $pair (keys %set) {
      die "$nr:Bad $type alignment '$pair', expected x-y."
        if $pair !~ /^\d+-\d+$/;
    }
    $data->{$type} = \%set;
    print STDERR "$type: "
      .join(" ", sort {$a cmp $b} keys %{$data->{$type}})."\n"
      if $debug;
  }
  # all sure alignments also count as possible

  foreach my $pair ((keys %{$data->{"sure"}}), (keys %{$data->{"onlyposs"}})) {
    $data->{"poss"}->{$pair} = 1;
  }

  # Increase counts for precision etc.
  $counts->{"sure"} += scalar keys %{$data->{"sure"}};
  $counts->{"poss"} += scalar keys %{$data->{"poss"}};
  $counts->{"cand"} += scalar keys %{$data->{"cand"}};
  foreach my $p (keys %{$data->{"cand"}}) {
    for my $type (qw(poss sure)) {
      print STDERR "$p seen in $type\n" if $debug && $data->{$type}->{$p};
    }
    $counts->{"sure-and-cand"}++ if $data->{"sure"}->{$p};
    $counts->{"poss-and-cand"}++ if $data->{"poss"}->{$p};
    $counts->{"onlyposs-and-cand"}++ if $data->{"onlyposs"}->{$p};
  }
  for my $val (qw(cand sure poss sure-and-cand poss-and-cand)) {
    print STDERR "$val: $counts->{$val}\n" if $debug;
  }
}

print STDERR "AER\tprec\trec\n";
printf "%.2f", 100*(1-
                     ($counts->{"sure-and-cand"}+$counts->{"onlyposs-and-cand"})                     /($counts->{"cand"}+$counts->{"sure"}));
print "\t";
printf "%.2f", $counts->{"cand"} 
               ? 100*$counts->{"poss-and-cand"}/$counts->{"cand"} : 1.0;
print "\t";
if ($counts->{"sure"} > 0 ) {
  printf "%.2f", 100*$counts->{"sure-and-cand"}/$counts->{"sure"};
} else {
  print "undef";
}
print "\n";

