#!/Perl/bin/perl

use strict;
use constant USAGE => "usage\n $0 RAWFILE DATAFILE\n";
use Data::Dumper;

use constant EL_LINE_NO => 0;
use constant EL_WORD => 1;
use constant EL_GUESSTAG => 2;
use constant EL_CORRECTTAG => 3;

($#ARGV == 1)
  or die USAGE;

my $ifname = shift;
my $ofname = shift;
$| = 1;
my $data = read_data ($ifname);
print STDERR "Found $#{$data} lines of data.\n";
my $errors = find_errors ($data);
print STDERR "Found $#{$errors} instances of mistagging.\n";
my $tokens =  [ (grep { (length ($_->[0]) > 0) } (@{$data})) ];
(my ($guess_tags, $correct_tags)) = @{ discover_tags ($tokens) };
print STDERR "Computing pair counts ...";
my $pair_counts = compute_pair_counts ($tokens);
print STDERR "Done\n";
my $accuracy = (($#{$tokens} + 1) - ($#{$errors} + 1)) / ($#{$tokens} + 1);
my $rand_accuracy = 1 / (scalar (keys %{$correct_tags}));
my $kappa = ($accuracy - $rand_accuracy) / (1 - $rand_accuracy);

my $all_data = {'pair_counts' => $pair_counts,
		'guess_tags' => $guess_tags,
		'correct_tags' => $correct_tags,
		'accuracy' => $accuracy,
		'kappa' => $kappa };

open (FH, ">", $ofname)
  or die "Can't open $ofname for writing: $!\n";
{
  local $Data::Dumper::Indent = 0;
  local $Data::Dumper::Terse = 1;
  print FH Dumper ($all_data), "\n";
}
close (FH);

sub compute_pair_counts {
  my $tokens = shift;

  (my ($guess_tags, $correct_tags)) = @{ discover_tags ($tokens) };
  my $pair_counts = [];

  foreach my $correct_tag (sort keys (%{$correct_tags})) {
    next unless (length ($correct_tag) > 0);
    foreach my $guess_tag (sort keys (%{$guess_tags})) {
      next unless (length ($guess_tag) > 0);
      my $pair_els =
	[ (grep { (($_->[1] eq $guess_tag)
		   and
		   ($_->[2] eq $correct_tag))
		} (@{$tokens})) ];
      push (@{$pair_counts}, [ $guess_tag, $correct_tag, ($#{$pair_els} + 1) ]);
    }
  }
  return $pair_counts;
}

sub read_data {
  my $fname = shift;

  open (FH, "<", $fname)
    or die "Can't open $fname: $!";

  while (<FH>) {
    chomp;
    (my ($word, $guess, $correct)) = ($_ =~ m{^(.*?) (.*?) (.*?)$});
    push (@{$data}, [$word, $guess, $correct]);
  }

  close (FH);

  return $data;
}

sub find_errors {
  my $data = shift;
  my $errors = [];

  for (my $i = 0; $i <= $#{$data}; $i++) {
    my $el = $data->[$i];
    if ($el->[1] ne $el->[2]) {
      push (@{$errors}, [$i, @{$el}]);
    }
  }

  return $errors;

}

sub discover_tags {

  my $data = shift;
  my $guess_tags = {};
  my $correct_tags = {};

  foreach my $el (@{$data}) {
    my $guess_tag = $el->[1];
#    foreach my $guess_tag (split (/|/, $el->[1])) {
    unless (exists ($guess_tags->{$guess_tag})) {
      $guess_tags->{$guess_tag} = 0;
    }
    $guess_tags->{$guess_tag}++;
    # }

    my $correct_tag = $el->[2];
#    foreach my $correct_tag (split (/|/, $el->[2])) {
    unless (exists ($correct_tags->{$correct_tag})) {
      $correct_tags->{$correct_tag} = 0;
    }
    $correct_tags->{$correct_tag}++;
    # }

  }

  return [$guess_tags, $correct_tags];

}
