#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

use Getopt::Std;

# estrae TP, FP, FN, Precision, Recall e F-Measure per ogni verbo per soglie crescenti
# stampa i risultati dell'analisi per ogni coppia verbo-soglia 
# stampa le medie dei valori di Precision, Recall e F-Measure per ogni soglia

# input: file valutazioniLexitVerbi.txt (N.B. i valori decimali utilizzano il punto). Il file in input deve terminare con una riga vuota.

# comando da shell: perl estraiPRF-M.pl -a [br|sc|p] < input_file > output_file

# Promemoria struttura input

#VERBO		FREQV	FRAME		FREQFLEX	ASSOFLEXIT	FREQREL	LEXIT	BR	SC	PAROLE
#abrogare	1409	subj#obj	817		848.0333	0,5798	1	1	1	1


my @verbi; #array multidimensionale. Ogni posizione è un array che memorizza i valori di TP, FP, FN, Precision, Recall e F-measure per il verbo e la soglia correnti
my @medie; #array multidimensionale; ogni posizione è un array che raccoglie le medie di Precision, Recall e F-Measure dei 100 verbi in input per una data soglia
my $tp = 0; #true positive
my $fp = 0; #false positive
my $fn = 0; #false negative
my $tn = 0; #true negative, conteggiati ma non registrati
my $precision; 
my $recall;
my $fmeasure;
my $soglia;
my $verbocorrente;
my $sogliaCorrente = 0.0000;
my @input; #array multidimensionale in cui viene memorizzato il file in input (ritenuto necessario visto la necessità di un ciclo per soglie diverse)

my $precisionMean = 0;
my $recallMean = 0;
my $fmeasureMean = 0;

# lo script va eseguito con opzione -a, definendo un parametro tra "br" (Blumenthal-Rovere), "sc" (Sabatini-Coletti), "p" (PAROLE). Di conseguenza saranno estratti i dati relativi a P, R & F-M di LexIt nei confronti del gold standard scelto.

my %opts = ();	#opzioni da linea di comando

getopt("a:",\%opts); 

my $goldStandard = 7; #default

if ($opts{a} =~ /br/) {
	$goldStandard = 7; # si confronta LexIt con Blumenthal-Rovere, all'indice 7 di ogni riga dell'input
}
elsif ($opts{a} =~ /sc/) {
	$goldStandard = 8; # Sabatini-Coletti corrisponde all'indice 8
}
elsif ($opts{a} =~ /p/) {
	$goldStandard = 9; # PAROLE corrisponde all'indice 9
}


# leggo il file di input parsato riga per riga e carico ogni riga in un array di array.

while (<STDIN>) {

	chomp;
	my @line = split;

	push (@input, \@line);
}

pop @input; #tronca l'ultimo elemento dell'array 


#ciclo esterno per calcolare P, R e F-M su soglie crescenti 

for ($soglia = 0.000; $soglia < 0.101; $soglia += 0.001) {

# assegnamenti che occorrono per riavviare il ciclo 
	$verbocorrente = $input[0][0]; # riparto dal primo dei cento verbi per ogni soglia
	$tp = 0;  $fp = 0; $fn = 0; $tn = 0; 


# ciclo che registra per ogni verbo P, R e F-M

	foreach my $riga (@input) {

		if (@$riga[0] eq $verbocorrente) { #se l'array corrente (riga dell'input) è ancora relativo al verbo corrente, si aggiornano tp, fp, fn
	
			# i false negative, essendo assenti in LexIt, hanno per definizione fr. relativa = 0
			if (@$riga[6] == 0 && @$riga[$goldStandard] == 1) {
				$fn++;
			}
			if (@$riga[5] >= $soglia) { #se la frequenza relativa del frame è maggiore o uguale alla soglia il frame viene analizzato, altrimenti saltato
		
				# in @$riga[6] si registra l'assenza/presenza (0/1) del frame in LexIt, in @Sriga[$goldStandard] l'assenza/presenza del frame nel GS di 				riferimento (scelto all'esecuzione del comando)

				if (@$riga[6] == 1 && @$riga[$goldStandard] == 1) { 
					$tp++;
				}
				elsif (@$riga[6] == 1 && @$riga[$goldStandard] == 0) {
					$fp++;
				}
				else {
					$tn++;
				}
			}

		}

		# è cambiato il verbo in esame, quindi memorizzo i valori del verbo precedente nell'array @verbi, azzero i valori e riavvio il ciclo foreach aggiornando il 			verbo corrente

		else {
			#evita divisioni "illegali" per 0, possibili nel caso tp = 0 (v. soglie molto alte)
			if ($tp != 0) {
				$precision = $tp / ($tp + $fp);
				$recall = $tp / ($tp + $fn);
				$fmeasure = 2*$precision*$recall / ($precision + $recall);
			}
			else {
				$precision = 0;
				$recall = 0;
				$fmeasure = 0;
			}

			my @verbo = ($verbocorrente, $soglia, $tp, $fp, $fn, $precision, $recall, $fmeasure);
			push ( @verbi, 	\@verbo );

			$tp = 0;  $fp = 0; $fn = 0; $tn = 0;
			$verbocorrente = @$riga[0]; #aggiorna il verbo corrente


			# analizzo la prima riga del nuovo verbo, che altrimenti non verrebbe registrata (il ciclo foreach passa alla riga successiva)
			if (@$riga[6] == 0 && @$riga[$goldStandard] == 1) {
				$fn++;
			}
			if (@$riga[5] >= $soglia) {
		
				if (@$riga[6] == 1 && @$riga[$goldStandard] == 1) {
					$tp++;
				}
				elsif (@$riga[6] == 1 && @$riga[$goldStandard] == 0) {
					$fp++;
				}
				else {
					$tn++;
				}
			}

		} 
	}

# a questo punto sono stati valutati tutti i verbi per la soglia corrente. Salvo i dati dell'ultimo verbo prima di proseguire il ciclo esterno for con una nuova soglia

	if ($tp != 0) {
		$precision = $tp / ($tp + $fp);
		$recall = $tp / ($tp + $fn);
		$fmeasure = 2*$precision*$recall / ($precision + $recall); } 
	else {
		$precision = 0;
		$recall = 0;
		$fmeasure = 0;
	}

	my @verbo = ($verbocorrente, $soglia, $tp, $fp, $fn, $precision, $recall, $fmeasure);
	push ( @verbi, 	\@verbo );

}


# Si esamina ogni riga (array) di @verbi e si calcola la media di Precision, Recall e F-Measure di ogni gruppo di 100 verbi per le soglie considerate

foreach my $riga (@verbi) {

	#@$riga[1] corrisponde alla soglia (v. riga 124). Finché la soglia è la stessa, si sommano i valori di P, R e F-M

	if (@$riga[1] eq $sogliaCorrente) {
		$precisionMean += @$riga[5];
		$recallMean += @$riga[6];
		$fmeasureMean += @$riga[7];
	}

	#cambiata la soglia, si calcolano le effettive medie di P R e F-M registrate per il gruppo di 100 verbi e si salvano in @medie
	else {	
		$precisionMean /= 100;
		$recallMean /= 100;
		$fmeasureMean /= 100;

		my @vettoreMedia = ($sogliaCorrente, $precisionMean, $recallMean, $fmeasureMean);
		push ( @medie, \@vettoreMedia );

	# azzero per il calcolo della soglia successiva
		$precisionMean = 0;
		$recallMean = 0;
		$fmeasureMean = 0;
		$sogliaCorrente = @$riga[1];

	# analizzo prima riga della nuova soglia

		$precisionMean += @$riga[5];
		$recallMean += @$riga[6];
		$fmeasureMean += @$riga[7];

	}
}

# Registro la media dell'ultima soglia considerata

$precisionMean /= 100;
$recallMean /= 100;
$fmeasureMean /= 100;

my @vettoreMedia = ($sogliaCorrente, $precisionMean, $recallMean, $fmeasureMean);
push ( @medie, \@vettoreMedia );


#Stampa valutazioni

print "verbo\tsoglia\ttp\tfp\tfn\tprecision\trecall\tfmeasure\n";
for (my $i = 0; $i < scalar (@verbi); $i++) {
	for (my $j = 0; $j < 8; $j++) {
		print "$verbi[$i][$j]\t";
	}
	print "\n";
}

#Stampa medie

print "\nsoglia\tprecision\t"."recall\t"."fmeasure\n";
foreach my $media (@medie) {
	foreach my $numero (@$media) {
		print "$numero\t";
	} 
	print "\n";
}

