#!/usr/bin/perl 

# Marie Candito (conll)
# modif by djame to handle ptb file processed by cat-tree -G
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                
use Getopt::Long;
$help = 0 ;
$mwe_label = 'dep_cpd' ;
$mwe_pos_feat = 'mwehead' ;
$compact_view = 0;
GetOptions(
	   "g:s" => \$g_file,
	   "s:s" => \$s_file,
	   "L!" => \$compact_view, # added by djame to display compact view of the scores
           "mwe_label:s" => \$mwe_label,
           "mwe_pos_feat:s" => \$mwe_pos_feat,
           "help!" => \$help) or die (&usage) ;

die(&usage) unless ($s_file && $g_file) ;
die(&usage) if ($help) ;
#print join(" ",@ARGV); die"ici";
sub usage
{
    return "\n SPMRL 2013 shared task evaluation script for French.

 EXPECTED FORMAT for marking MWEs:

    The script supposes that all MWEs are flat, with one component governing
    all the other components of the MWE with dependencies labeled <MWE_LABEL>.
    If provided, the additional information of the part-of-speech of the MWE
    is expected to be given as value of a <MWE_POS_FEAT> feature, on the head token
    of the MWE.

 OUTPUT: 

    The script outputs in any case two evaluations, and possibly a third one :

    - precision/recall/Fmeas on components of MWEs (excluding heads of MWEs)
      A component of MWE is counted as correct if it is attached to the same 
      token as in the gold file, with label <MWE_LABEL>

    - precision/recall/Fmeas on full MWEs
      A MWE is counted as correct if its sequence of tokens also forms 
      a MWE in gold file

    - if both the gold file and the system files do contain at least one <MWE_POS_FEAT> feature,
      then a third evaluation is also provided, which uses a stricter criteria
      for full MWEs : they have to be composed of the same tokens as in gold file AND the gold
      and predicted part-of-speech for the MWE have to match.


 USAGE: perl do_eval_dep_mwe.pl [OPTIONS] -g <gold standard conll> -s <system output conll>

    [ -mwe_label <MWE_LABEL> ] label used for components of MWEs. Default = dep_cpd
    [ -mwe_pos_feat <MWE_POS_FEAT> ] use to define the feature name that marks heads of MWEs. Default = mwehead
	[ -L ] provides also a compact view of the results (to be grep-ed by grep \"F_mwe\" )
	[ -help ]\n\n" ;
}

sub normalize_line
{
    my $s = shift ;
    chomp($s) ;
    $s =~ s/[\r\n]*// ;
    return $s ;
}

sub process_conll_line
{
    my $s = shift ;

    my @cols = split(/\t/, $s) ;
    my $idx = $cols[0] ; # token rank in sentence
    my $govidx = $cols[6] ; # token's governor rank

    # whether token is a component of a MWE (and not its head)
    my $is_mwe_c = ($cols[7] eq $mwe_label) ? 1 : 0 ; 

    # if mwe pos feat is provided, record the POS of the MWE
    my $mwe_pos_val = '' ;
    if ($s =~ /[\t\|]$mwe_pos_feat=([^\|\t]+)/)
    {
	$mwe_pos_val = $1 ;
    }

    return ($is_mwe_c, $idx, $govidx, $mwe_pos_val) ;
}

sub is_sent_sep
{
    my $s = shift ;
    return ($s eq '') ;
}

sub measures
{
    my $nb_gold = shift ;
    my $nb_pred = shift ;
    my $nb_both = shift ;

	# modif by djame: avoiding divide by zero error
    my $recall = ($nb_gold>0 ?  100 * ($nb_both / $nb_gold):0) ;
    my $prec = ($nb_pred>0? 100 * ($nb_both / $nb_pred):0) ; 
	if (($recal+$prec) > 0) {
		return ( $recall, $prec, (2*$recall*$prec / ($prec + $recall)) ) ;
	}else{
			return ( 0, 0, 0);
		}
    
}

#---------------------------------
# MAIN
#---------------------------------

open(GOLD, "< $g_file") || die("Impossible to open $g_file for read: $!") ;
open(SYSTEM, "< $s_file") || die("Impossible to open $system_file for read: $!") ;

@g_lines = <GOLD> ;
@s_lines = <SYSTEM> ;
close(GOLD) || die("Impossible to close $g_file: $!") ;
close(SYSTEM) || die("Impossible to close $g_file: $!") ;

die("Number of lines in both files do not match!") if ($#g_lines ne $#s_lines) ; 

$nb_sent = 1 ;

# number of components of MWEs (not including the head components) in gold, in prediction, in intersection files 
$nb_g_components = 0 ;
$nb_s_components = 0 ;
$nb_correct_components = 0 ;

my %g_mwes = () ;
my %s_mwes = () ;
my %g_mwepos = () ;
my %s_mwepos = () ;

for $i (0..$#g_lines)
{
    $g_line = &normalize_line($g_lines[$i]) ;
    $s_line = &normalize_line($s_lines[$i]) ;

    # sentence separator lines
    if (&is_sent_sep($g_line))
    {
	$nb_sent += 1 ;

	die("Mismatch of sentence separator line ".$i) if (!(&is_sent_sep($s_line))) ;
	
    }
    # token lines
    else
    {
	die("Mismatch of sentence separator line ".$i) if (&is_sent_sep($s_line)) ;

	my ($g_is_mwe_c, $g_idx, $g_govidx, $g_mhp) = &process_conll_line($g_line) ;
	my ($s_is_mwe_c, $s_idx, $s_govidx, $s_mhp) = &process_conll_line($s_line) ;

	die("Mismatch of token rank line ".$i." ($g_idx, $s_idx)") if ($g_idx ne $s_idx) ;

	$nb_g_components += 1 if ($g_is_mwe_c) ;
	$nb_s_components += 1 if ($s_is_mwe_c) ;
	# component counts as correct if same governor in gold and in prediction, and pos of mwe is correct
	$nb_correct_components += 1 if ($g_is_mwe_c && $s_is_mwe_c && ($g_govidx eq $s_govidx)) ;

	if ($g_is_mwe_c)
	{
	    $key = $nb_sent.'.'.$g_govidx ; # head of mwe is governor of current token
	    if (!defined($g_mwes{$key})) { $g_mwes{$key} = '' ;}
	    $g_mwes{$key} .= '.'.$g_idx ;
	}
	if ($s_is_mwe_c)
	{
	    $key = $nb_sent.'.'.$s_govidx ;
	    if (!defined($s_mwes{$key})) { $s_mwes{$key} = '' ;}
	    $s_mwes{$key} .= '.'.$s_idx ;
	}

	# if pos of mwe is provided (on the token that is head of the MWE)
	if ($g_mhp)
	{
	    $key = $nb_sent.'.'.$g_idx ;
	    $g_mwepos{$key} = $g_mhp ;
	    #print "$key  g_mhp:".$g_mhp."\n"; 
	}
	if ($s_mhp)
	{
	    $key = $nb_sent.'.'.$s_idx ;
	    $s_mwepos{$key} = $s_mhp ;
	    #print "$key   s_mhp:".$s_mhp."\n"; 
	}

    }
    
}

# number of MWEs in gold, in prediction, in intersection
$nb_g_mwes = scalar keys %g_mwes ;
$nb_s_mwes = scalar keys %s_mwes ;
$nb_correct_mwes = 0 ;
$nb_correct_mwes_eval_mwe_pos = 0 ;

for $key ( keys %g_mwes )
{
    if (defined($s_mwes{$key}) && ($s_mwes{$key} eq $g_mwes{$key}))
    {
	$nb_correct_mwes += 1 ;

	if (defined($s_mwepos{$key}) && defined($g_mwepos{$key}))
	{
	    if ($s_mwepos{$key} eq $g_mwepos{$key})
	    {
		$nb_correct_mwes_eval_mwe_pos += 1 ;
	    }
	}

	# if system file and gold file each contain at least one $mwe_pos_feat, then keep track of inconsistencies
	elsif (( scalar keys %s_mwepos ) && ( scalar keys %g_mwepos ))
	{
	    print "Inconsistent data: $mwe_pos_feat feature not defined at sentence.token $key, while some other token is marked as its component\n" ;
	}
    }
}

	printf STDOUT "\nTotal nb of sentences : ".($nb_sent-1)."\tfile: $s_file\n\n" ;
	printf STDOUT "                             Recall Precision Fscore\n" ;
	($r, $p, $f) = &measures($nb_g_mwes, $nb_s_mwes, $nb_correct_mwes) ;
	printf STDOUT "Full MWEs                    %1.2f  %1.2f     %1.2f  (gold = $nb_g_mwes, sys = $nb_s_mwes, correct = $nb_correct_mwes)\n", $r, $p, $f ;
	if ($nb_correct_mwes_eval_mwe_pos)
	{
	    ($r, $p, $f) = &measures($nb_g_mwes, $nb_s_mwes, $nb_correct_mwes_eval_mwe_pos) ;
	    printf STDOUT "Full MWEs with correct POS   %1.2f  %1.2f     %1.2f  (gold = $nb_g_mwes, sys = $nb_s_mwes, correct = $nb_correct_mwes_eval_mwe_pos)\n", $r, $p, $f ;
	}
	($r, $p, $f) = &measures($nb_g_components, $nb_s_components, $nb_correct_components) ;
	printf STDOUT "Components                   %1.2f  %1.2f     %1.2f  (gold = $nb_g_components, sys = $nb_s_components, correct = $nb_correct_components)\n\n", $r, $p, $f ;
	

	if ($compact_view == 1){  # compact view
		($r, $p, $f) = &measures($nb_g_mwes, $nb_s_mwes, $nb_correct_mwes) ;
		#printf STDOUT "Full MWEs                    %1.2f  %1.2f     %1.2f  (gold = $nb_g_mwes, sys = $nb_s_mwes, correct = $nb_correct_mwes)\n", $r, $p, $f ;
		
		($rc, $pc, $fc) = &measures($nb_g_components, $nb_s_components, $nb_correct_components) ;
		#printf STDOUT "Components                   %1.2f  %1.2f     %1.2f  (gold = $nb_g_components, sys = $nb_s_components, correct = $nb_correct_components)\n\n", $r, $p, $f ;
		
		if ($nb_correct_mwes_eval_mwe_pos)
		{
		    ($rf, $pf, $ff) = &measures($nb_g_mwes, $nb_s_mwes, $nb_correct_mwes_eval_mwe_pos) ;
		  #  printf STDOUT "Full MWEs with correct POS   %1.2f  %1.2f     %1.2f  (gold = $nb_g_mwes, sys = $nb_s_mwes, correct = $nb_correct_mwes_eval_mwe_pos)\n", $r, $p, $f ;
		}else{
			 ($rf, $pf, $ff)=("n/a","n/a","n/a");
		}
		printf STDOUT "F_mwe: %1.2f\tR_mwe: %1.2f\tP_mwe: %1.2f\t",$f,$r,$p;
		printf STDOUT "F_cmp: %1.2f\tR_cmp: %1.2f\tP_cmp: %1.2f\t",$fc,$rc,$pc;
		printf STDOUT "F_mwe+P: %1.2f\tR_mwe+P: %1.2f\tP_mwe+P: %1.2f\t",$ff,$rf,$pf;
		printf STDOUT "file: %s\n",$s_file;
	}