#!/usr/bin/perl

$usage = "Usage: cat <goldfilelist> |$0 [-i] [-v] [-p <num>] "
	."[-s] <export directory>\n"
	."\t-i: ignore gold where parse failed\n"
	."\t-v: verbose output\n"
	."\t-p <num>: parse number (defaults to 0)\n"
	."\t-s: raw figures for statistical significance calculations\n";
$verbose = 0;
$ignore = 0;
$pnum = 0;

while(($arg = shift @ARGV) =~ /^-/)
{
	if($arg =~ /^-v$/) { $verbose = 1; }
	elsif($arg =~ /^-i$/) { $ignore = 1; }
	elsif($arg =~ /^-p$/) {$pnum = shift;}
	elsif($arg =~ /^-s$/) {$stats = 1;}
	else { die "Unknown option $arg\n$usage"; }
}
if($arg) { $PROFILEDIR = $arg; }
else { die $usage; }

%goldtotal;
%testtotal;
%correct;

$files = 0; #number of valid gold items
$testfiles = 0; #number of gold files with a corresponding test file
$exactmatch = 0;
$exactmatchargs = 0;
$exactmatchnargs = 0;

#read list of gold files
while(<>)
{
	my @gold; #list of each gold analysis, generally length 1
	my %test;
	my $file = $_;
	chomp $file;
	if($file =~ /.*\/(\d+\.gz)/) { $base = $1; }
	elsif($file =~ /^(\d+\.gz)$/) { $base = $1; }
	else
	{
		print STDERR "weird file: $file, skipping\n";
		next;
	}
	#open and parse gold file
	open(GOLDIN, "zcat $file |") or 
		die "Couldn't parse $file: $!\n";
	$in_triple = 0; #state variable
	$item = "";
	my %gold; #details of current gold analysis
	while(<GOLDIN>)
	{
		next if /^$/;
		if($in_triple == 1)
		{
			if(/^}$/)
			{#end ltriple representation of current analysis
				if($gold{'total'}{'NAMES'} > 0)
				{#don't add empty analyses
					$gold{'total'}{'ALL'} += $gold{'total'}{'NAMES'};
					push @gold, { %gold };
				}
				%gold = ();
				$in_triple = 0;
				next; #look for more analyses
			}
			chomp;
			my ($rel1, $pred, $rel2) = split;
			$rel1 =~ s/(.*)(<\d+:\d+>).*/\2/;#ignore pred name in matching rels 
			$name1 = $1; #but keep the name to check separately
			$gold{$rel1} = {} unless exists $gold{$rel1};
			$gold{$rel1}->{'NAMES'} = [] unless exists $gold{$rel1}->{'NAMES'};
			#add a NAME relation for the pred name, if not already added
			$gold{'total'}{'NAMES'} += add_name($gold{$rel1}->{'NAMES'}, $name1);
			$gold{$rel1}->{$pred} = [] unless exists $gold{$rel1}->{$pred};
			if($rel2 =~ /^(.*)(<\d+:\d+>)/)
			{
				$rel2 = $2;
				$name2 = $1;
				$gold{$rel2}->{'NAMES'} = [] unless exists $gold{$rel2}->{'NAMES'};
				#add a NAME relation for the pred name, if not already added
				$gold{'total'}{'NAMES'} += add_name($gold{$rel2}->{'NAMES'},$name2);
			}
			push @{$gold{$rel1}->{$pred}}, $rel2;
			$gold{'total'}{'ALL'}++;
			$gold{'total'}{$pred}++;
			if(is_arg($pred))  
			{
				$gold{'total'}{'ARGS'}++;
			}
			else
			{
				$gold{'total'}{'PROPS'}++;
			}
		}
		elsif(/\[\d+\] \(\d+ of \d+\) \{\d+\} `(.*)' \[.*\]$/)
		{#grab the item string for verbose output
			$item = $1;
		}
		elsif(/^{$/)
		{#start of the ltriple representation of an analysis
			$in_triple = 1;
		}
	} #finished reading gold file
	close GOLDIN or warn "something odd closing gold pipe:$!\n";
	next if (scalar @gold) == 0; #skip files with no extractable triples
	$files++; #total valid gold items
	if( -e "$PROFILEDIR/$base")
	{#test analysis found
		$testfiles++;
		open(TESTIN, "zcat $PROFILEDIR/$base |") or 
			die "Couldn't parse $PROFILEDIR/$base: $!\n";
		my $parseno=-1;
		$in_triple = 0;
		while(<TESTIN>)
		{#read the test file
			next if /^$/;
			if($in_triple == 1)
			{
				if(/^}$/)
				{
					if($parseno == $pnum)
					{
						$test{'total'}{'ALL'} += $test{'total'}{'NAMES'};
					}
					$in_triple = 0;
					next;
				}
				next if $parseno != $pnum;
				chomp;
				my ($rel1, $pred, $rel2) = split;
				$rel1 =~ s/(.*)(<\d+:\d+>).*/\2/; 
				$name1 = $1;
				$test{$rel1}->{'NAMES'} = [] unless exists $test{$rel1}->{'NAMES'};
				$test{'total'}{'NAMES'} += add_name($test{$rel1}->{'NAMES'},$name1);
				$test{$rel1} = {} unless exists $test{$rel1};
				$test{$rel1}->{$pred} = [] unless exists $test{$rel1}->{$pred};
				if($rel2 =~ /^(.*)(<\d+:\d+>)/)
				{
					$rel2 = $2;
					$name2 = $1;
					$test{$rel2}->{'NAMES'}=[] unless exists $test{$rel2}->{'NAMES'};
					$test{'total'}{'NAMES'}+=add_name($test{$rel2}->{'NAMES'},
						$name2);
				}
				push @{$test{$rel1}->{$pred}}, $rel2;
				$test{'total'}{'ALL'}++;
				$test{'total'}{$pred}++;
				if(is_arg($pred))
				{
					$test{'total'}{'ARGS'}++;
				}
				else
				{
					$test{'total'}{'PROPS'}++;
				}
			}
			elsif(/^\[(\d+):(\d+)\] \(.*active\)$/)
			{
				$parseno = $2;
			}
			elsif(/^{$/)
			{
				$in_triple = 1;
			}
		} #finished reading test file
		close TESTIN or warn "something odd closing test pipe:$!\n";

		$bestf = 0; #best edm all fscore
		$besti = 0; #which gold analysis is the best match, by edm all fscore
		for($goldi=0; $goldi <= $#gold; $goldi++)
		{
			$gold[$goldi]{'correct'} = {}; 
			$gold[$goldi]{'errors'} = [];
			$gold[$goldi]{'correct'}{'ALL'} = 0
				unless defined $gold[$goldi]{'correct'}{'ALL'};
			$gold[$goldi]{'correct'}{'ARGS'} = 0
				unless defined $gold[$goldi]{'correct'}{'ARGS'};
			$gold[$goldi]{'correct'}{'PROPS'} = 0
				unless defined $gold[$goldi]{'correct'}{'PROPS'};
			%temptest = {}; 
			foreach $k1 (keys %test)
			{
				next if $k1 eq "total";
				$temptest{$k1} = {};
				foreach $k2 (keys %{$test{$k1}})
				{
					$temptest{$k1}{$k2} = [ @{$test{$k1}{$k2}} ];
				}
			}
			foreach my $r1 (keys %{$gold[$goldi]})
			{
				next if $r1 eq "total" or $r1 eq "correct" or $r1 eq "errors";
				foreach my $p (keys %{$gold[$goldi]->{$r1}})
				{
					foreach my $r2 (@{$gold[$goldi]->{$r1}->{$p}})
					{
						if(exists $temptest{$r1} and exists $temptest{$r1}->{$p})
						{
							my $found = 0;
							for(my $i=0; $i < scalar @{$temptest{$r1}->{$p}}; $i++)
							{
								if($temptest{$r1}->{$p}->[$i] eq $r2)
								{
									$gold[$goldi]{'correct'}{'ALL'}++;
									$gold[$goldi]{'correct'}{$p} = 0
										unless defined $gold[$goldi]{'correct'}{$p};
									$gold[$goldi]{'correct'}{$p}++;
									$found = 1;
									if(is_arg($p))
									{
										$gold[$goldi]{'correct'}{'ARGS'}++;
									}
									elsif($p ne "NAMES")
									{
										$gold[$goldi]{'correct'}{'PROPS'}++;
									}
									delete $temptest{$r1}->{$p}->[$i];
									last;
								}
							}
							if($found == 0)
							{
								if($verbose)
								{ #grab item span for verbose output
									$vr1 = "";
									$vr2 = "";
									if($item ne "")
									{ 
										if($r1 =~ /<(\d+):(\d+)>/)
										{
											$vr1 = "\"". substr($item, $1, $2-$1+1). "\" ";
										}
										if($r2 =~ /<(\d+):(\d+)>/)
										{
											$vr2 = "\"". substr($item, $1, $2-$1+1). "\" ";
										}
									}
									my %temperr;
									$temperr{'DIR'} = ">";
									$temperr{'VR1'} = $vr1;
									$temperr{'R1'} = $r1;
									$temperr{'P'} = $p;
									$temperr{'VR2'} = $vr2;
									$temperr{'R2'} = $r2;
									push @{$gold[$goldi]{'errors'}}, { %temperr };
								}
							}
							delete $temptest{$r1}->{$p} 
								if scalar @{$temptest{$r1}->{$p}} == 0;
						}
						else
						{
							if($verbose)
							{ #grab item span for verbose output
								$vr1 = "";
								$vr2 = "";
								if($item ne "")
								{
									if($r1 =~ /<(\d+):(\d+)>/)
									{
										$vr1 = "\"". substr($item, $1, $2-$1+1). "\" ";
									}
									if($r2 =~ /<(\d+):(\d+)>/)
									{
										$vr2 = "\"". substr($item, $1, $2-$1+1). "\" ";
									}
								}
								my %temperr;
								$temperr{'DIR'} = ">";
								$temperr{'VR1'} = $vr1;
								$temperr{'R1'} = $r1;
								$temperr{'P'} = $p;
								$temperr{'VR2'} = $vr2;
								$temperr{'R2'} = $r2;
								push @{$gold[$goldi]{'errors'}}, { %temperr };
							}
						}
					}
				}
			}
			if($verbose)
			{
				foreach my $r1 (keys %temptest)
				{
					foreach my $p (keys %{$temptest{$r1}})
					{
						foreach my $r2 (@{$temptest{$r1}->{$p}})
						{
							$vr1 = "";
							$vr2 = "";
							if($item ne "")
							{
								if($r1 =~ /<(\d+):(\d+)>/)
								{
									$vr1 = "\"". substr($item, $1, $2-$1+1). "\" ";
								}
								if($r2 =~ /<(\d+):(\d+)>/)
								{
									$vr2 = "\"". substr($item, $1, $2-$1+1). "\" ";
								}
							}
							my %temperr;
							$temperr{'DIR'} = "<";
							$temperr{'VR1'} = $vr1;
							$temperr{'R1'} = $r1;
							$temperr{'P'} = $p;
							$temperr{'VR2'} = $vr2;
							$temperr{'R2'} = $r2;
							push @{$gold[$goldi]{'errors'}}, { %temperr };
						}
					}
				}
			}
			my $f = 0; #edm all fscore
			if($test{'total'}{'ALL'} == 0)
			{
				$prec = 0;
				$rec = 0;
				$f = 0;
			}
			else
			{
				$rec=$gold[$goldi]{'correct'}{'ALL'}/$gold[$goldi]{'total'}{'ALL'};
				$prec=$gold[$goldi]{'correct'}{'ALL'}/$test{'total'}{'ALL'};
				$f = (2*$prec*$rec)/($prec+$rec) unless $prec == 0 and $rec == 0;
			}
			if($f > $bestf)
			{
				$bestf = $f;
				$besti = $goldi;
			}
		} #checked through each gold analysis and found the best match
		$exactmatch++ if $bestf == 1; #exact sentence match, all

		$exactmatchargs++  #exact sentence match, args
			if $gold[$besti]{'total'}{'ARGS'} == $gold[$besti]{'correct'}{'ARGS'};

		$exactmatchnargs++ #exact sentence match names, args
			if ($gold[$besti]{'total'}{'ARGS'}+$gold[$besti]{'total'}{'NAMES'})==
			($gold[$besti]{'correct'}{'ARGS'}+$gold[$besti]{'correct'}{'NAMES'});

		if($bestf == 1 and 
			$gold[$besti]{'total'}{'ARGS'} != $gold[$besti]{'correct'}{'ARGS'})
		{ #error checking
			print STDERR "$base: f=1 but ".$gold[$besti]{'total'}{'ARGS'}.
				" does not equal ".$gold[$besti]{'correct'}{'ARGS'}."($besti)\n";
		}

		foreach $type (keys %{$gold[$besti]{'total'}})
		{
			if(! defined $goldtotal{$type})
			{
				$goldtotal{$type} = 0;
			}
			$goldtotal{$type} += $gold[$besti]{'total'}{$type};
		}
		foreach $type (keys %{$gold[$besti]{'correct'}})
		{
			$correct{$type} = 0 unless defined $correct{$type};
			$correct{$type} += $gold[$besti]{'correct'}{$type};
		}
		foreach $type (keys %{$gold[$besti]{'total'}})
		{
			$testtotal{$type} = 0 unless defined $testtotal{$type};
			$testtotal{$type} += $test{'total'}{$type};
		}
		if($verbose)
		{
			print "\n";
			foreach $e (sort errsort @{$gold[$besti]{'errors'}})
			{
				printf "%s%s %s%s:%s:%s%s\n", "$base:",$e->{'DIR'},
					$e->{'VR1'}, $e->{'R1'}, $e->{'P'},
					$e->{'VR2'}, $e->{'R2'};
			}
		}
	}
	else
	{#no parse for this gold item
		unless($ignore)
		{#count the zeros
			foreach $type (keys %{$gold[0]{'total'}})
			{
				$goldtotal{$type} = 0 unless defined $goldtotal{$type};
				$goldtotal{$type} += $gold[0]{'total'}{$type};
			}
		}
		print STDERR "no $PROFILEDIR/$base\n";
	}
}
if($files == 0)
{
	print STDERR "No valid gold triples found, exiting.\n";
	exit;
}
if($ignore)
{#score only over items with parses
	$totalfiles = $testfiles;
}
else
{#score over all gold items
	$totalfiles = $files;
}
if($stats == 1)
{#output for statistical significance testing
	printf "%s\t%d\t%d\t%d\t%d\t%d\t%d\t%d\t%d\t%d\t%d\t%d\t%d\n", $base, 
		$correct{'ALL'}, $goldtotal{'ALL'}, $testtotal{'ALL'},
		$correct{'ARGS'}, $goldtotal{'ARGS'}, $testtotal{'ARGS'},
		$correct{'NAMES'}, $goldtotal{'NAMES'}, $testtotal{'NAMES'},
		$correct{'ARGS'}+$correct{'NAMES'}, 
		$goldtotal{'ARGS'}+$goldtotal{'NAMES'}, 
		$testtotal{'ARGS'}+$testtotal{'NAMES'};
}
else
{
	$recall = 0;
	$precision = 0;
	$recall = $exactmatch/$totalfiles;
	$precision = $exactmatch/$testfiles if $testfiles !=0;
	printf "%15s\t%5s\t%5s\t%5s\t%s\n", "", 
		"Prec", "Rec", "F", "";
	printf "%15s\t%.3f\t%.3f\t%.3f\t%s\n", "SENTENCE-EDM", 
		$precision, $recall,
		$exactmatch==0?0:(2*$precision*$recall)/($precision+$recall), 
		"$exactmatch/$totalfiles";

	$recall = 0;
	$precision = 0;
	$recall = $exactmatchargs/$totalfiles;
	$precision = $exactmatchargs/$testfiles if $testfiles != 0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%s\n", "SENTENCE-EDM_A",$precision, 
		$recall,$exactmatchargs==0?0:(2*$precision*$recall)/($precision+$recall),
		"$exactmatchargs/$totalfiles";

	$recall = 0;
	$precision = 0;
	$recall = $exactmatchnargs/$totalfiles;
	$precision = $exactmatchnargs/$testfiles if $testfiles != 0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%s\n", "SENTENCE-EDM_NA",$precision, 
		$recall,$exactmatchnargs==0?0:(2*$precision*$recall)/($precision+$recall),
		"$exactmatchnargs/$totalfiles";

	printf "\n%15s\t%5s\t%5s\t%5s\t%6s\t%s\n", "", 
		"Prec", "Rec", "F", "Total", "Ave/Item";
	$recall = 0;
	$precision = 0;
	$recall = $correct{'ALL'}/$goldtotal{'ALL'} if $goldtotal{'ALL'} != 0;
	$precision = $correct{'ALL'}/$testtotal{'ALL'} if $testtotal{'ALL'} != 0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", "EDM", $precision, $recall,
		$correct{'ALL'}==0?0:(2*$precision*$recall)/($precision+$recall),
		$goldtotal{'ALL'}, $goldtotal{'ALL'}/$totalfiles;

	$recall = 0;
	$precision = 0;
	$recall =
	($correct{'NAMES'}+$correct{'ARGS'})/($goldtotal{'NAMES'}+$goldtotal{'ARGS'})
		if ($goldtotal{'NAMES'}+$goldtotal{'ARGS'}) != 0;
	$precision = 
	($correct{'NAMES'}+$correct{'ARGS'})/($testtotal{'NAMES'}+$testtotal{'ARGS'})
		if ($testtotal{'NAMES'}+$testtotal{'ARGS'}) != 0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", "EDM_NA", $precision, $recall,
	($correct{'NAMES'}+$correct{'ARGS'})==0?
		0:(2*$precision*$recall)/($precision+$recall),
		($goldtotal{'NAMES'}+$goldtotal{'ARGS'}), 
		($goldtotal{'NAMES'}+$goldtotal{'ARGS'})/$totalfiles;

	$recall = 0;
	$precision = 0;
	$recall = $correct{'ARGS'}/$goldtotal{'ARGS'} if $goldtotal{'ARGS'} != 0;
	$precision = $correct{'ARGS'}/$testtotal{'ARGS'} if $testtotal{'ARGS'} != 0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", "EDM_A", $precision, $recall,
		$correct{'ARGS'}==0?0:(2*$precision*$recall)/($precision+$recall),
		$goldtotal{'ARGS'}, $goldtotal{'ARGS'}/$totalfiles;

	$recall = 0;
	$precision = 0;
	$recall = $correct{'NAMES'}/$goldtotal{'NAMES'} if $goldtotal{'NAMES'} != 0;
	$precision = $correct{'NAMES'}/$testtotal{'NAMES'} if $testtotal{'NAMES'}!=0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", "EDM_N", $precision, $recall,
		$correct{'NAMES'}==0?0:(2*$precision*$recall)/($precision+$recall),
		$goldtotal{'NAMES'}, $goldtotal{'NAMES'}/$totalfiles;

	$recall = 0;
	$precision = 0;
	$recall = $correct{'PROPS'}/$goldtotal{'PROPS'} if $goldtotal{'PROPS'} != 0;
	$precision = $correct{'PROPS'}/$testtotal{'PROPS'} if $testtotal{'PROPS'}!=0;
	printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", "EDM_P", $precision, $recall,
		$correct{'PROPS'}==0?0:(2*$precision*$recall)/($precision+$recall),
		$goldtotal{'PROPS'}, $goldtotal{'PROPS'}/$totalfiles;

	print "\n";

	foreach my $k (sort keys %goldtotal)
	{
		if($k ne "ALL" and $k ne "ARGS" and $k ne "PROPS" and $k ne "NAMES")
		{
			$recall = 0;
			$precision = 0;
			$recall = $correct{$k}/$goldtotal{$k} if $goldtotal{$k} != 0;
			$precision = $correct{$k}/$testtotal{$k} if $testtotal{$k} != 0;
			printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", $k, $precision, $recall,
				$precision+$recall> 0?(2*$precision*$recall)/($precision+$recall):0,
				$goldtotal{$k}, $goldtotal{$k}/$totalfiles;

			delete $testtotal{$k};
		}
	}
	foreach my $k (sort keys %testtotal)
	{
		if($k ne "ALL" and $k ne "ARGS" and $k ne "PROPS" and $k ne "NAMES")
		{
			$recall = 0;
			$precision = 0;
			$recall = $correct{$k}/$goldtotal{$k} if $goldtotal{$k} != 0;
			$precision = $correct{$k}/$testtotal{$k} if $testtotal{$k} != 0;
			printf "%15s\t%.3f\t%.3f\t%.3f\t%6d\t%.3f\n", $k, $precision, $recall,
				$precision+$recall> 0?(2*$precision*$recall)/($precision+$recall):0,
				$goldtotal{$k}, $goldtotal{$k}/$totalfiles;

			delete $testtotal{$k};
		}
	}
}
		
sub is_arg {
	my $p = $_[0];
	return 1 if($p =~ /^ARG/ or $p eq "R-INDEX" or $p eq "L-INDEX" 
		or $p eq "RSTR" or $p eq "R-HNDL" or $p eq "L-HNDL");
	return 0;
}
	
sub add_name {
	($listref, $name) = @_;
	$found = 0;
	foreach my $l (@{$listref})
	{
		$found = 1 if $l eq $name;
	}
	if($found == 0)
	{
		push @{$listref}, $name;
		return 1;
	}
	else
	{
		return 0;
	}
}

sub errsort {
	substr($a->{'R1'},1) <=> substr($b->{'R1'},1)
		or substr($a->{'R1'},index($a->{'R1'},":")+1) 
			<=> substr($b->{'R1'},index($b->{'R1'},":")+1)
		or $a->{'P'} cmp $b->{'P'}
		or $a->{'DIR'} cmp $b->{'DIR'};
}
