#!/usr/bin/perl

use strict;
use Getopt::Std;

my %opts = ();		#opzioni da linea di comando

# estrae dal file delle dipendenze i frames in versione sintetica:
# lemma + frame sintattico + slot + filler
# input: file di frames + slots + fillers generato da estraiDep.desr.pl
# output:
# 1. file con il seguente formato:
# lemma frame
# 2. file con il seguente formato
# lemma frame slot filler 

#usage contaFramesFillers.desr.pl -l lista_frames -i input_file

my @line;	# array di ogni frame
my %frames;     # hash di hash. La key e' un lemma e il valore e' un hash con key il frame e value la sua freq.
my %lemmaFreq;  # hash in cui a ogni lemma e' associata la sua freq globale
my %listaFrames;# hash che contiene la lista dei frames selezionati con la loro freq
my $printFlag;	# questa variabile č settata a 1, se viene individuato un frame
 

getopt("li",\%opts);


#se l'opzione -l e'  settata, carico i frames nella lista in un hash. Le keys sono i frames  e i value la loro freq

if (exists $opts{l}) {

	open (LISTAFRAMES, "$opts{l}");

	while (<LISTAFRAMES>) {
		
		chomp;

		my @frame = split;

		$listaFrames{$frame[0]} = $frame[1]

	}

}

open (INPUT, "$opts{i}");


#apro file in cui stampo i frames estratti

open (TEMPFRAME, ">$opts{i}.frame");

#apro file in cui stampo i frames estratti con i fillers

open (TEMPFILLER, ">$opts{i}.filler");

#leggo il file di input

while (<INPUT>) {
	
	chomp;

#salvo il lemma nella variabile di stampa
	
	s/lemma="(.+?)"\s(.+)$/\2/;
	
	my $printFrame = "$1 ";
			
#aggiungo il si nella variabile di stampa	
		
	if (/si="1"/) {$printFrame = $printFrame."si#"}

#sostituisco soggetti passivi con obj: soggetti passivi sono subj_pass oppure subj con aux=2_essere oppure venire
#(i comp_da sono trattati in quel caso come soggetti)

	if (/aux="(2_essere|venire)"/ || /subj_pass/) {
		
		s/subj(_pass)?/obj/;
		
		s/comp_da/subj/;
		
	}

#elimino informazione su aux, mood, clitico, ecc.

	s/aux="(.+?)"\ssi="."\smood="(.+?)"\s?//;
	

#normalizzo alcune preposizioni
	
	s/_(ad|al)=/_a=/g;
	s/_fra=/_tra=/g;
	s/_d'/_di/g;
	s/(_sin|_fin|_sino)[_=]/_fino/g;

#non stampo gli slot temporali (comp-temp, cpred-temp)

	s/comp-temp.+?=".+?"\s?//g;
	s/cpred-temp.+?=".+?"\s?//g;

#non stampo l'informazione sul tipo di determinante del nome, sulla presenza di modificatori numerali e sulla presenza di congiunti. Non stampo "comp_piĂ" o "inf_piĂ"
	
	s/det=".+?"\s?//g;
	s/modnum="yes"\s?//g;
	s/(conj|disj)(_.+?)?=".+?"\s?//g;
	s/.+?_piĂ=".+?"\s//g;
	
#elimino i sottotipi di comp e pred

	s/comp-(ind|loc)/comp/g;
	s/cpred-loc/cpred/g;

#faccio una copia della riga del frame

	my $copyFrame = $_;

#non stampo il soggetto, i modificatori avverbiali (modadv e modver) e i modificatori aggettivali nel frame

	s/(subj|modadv|modver|modadj)=".+?"\s?//g;

	s/\s+$//;

#cancello i fillers

	s/=".+?"//g;

	$printFlag = 0;

	if ($_ eq "") {

#se il frame e' vuoto (non ha slot a parte il soggetto) stampo 0
#anche nel file dei fillers
		
		$printFrame = $printFrame."0";
		
		print TEMPFRAME "$printFrame\n";
		
		$printFlag = 1;
	
	} else {	
		
		if (exists $opts{l}) {

#controllo se il frame appare nella lista dei frames caricata. Se vi compare, stampo il frame,
#altrimenti cerco tutti i possibili sottoframe attestati nela lista

			my $frame = $_;
			
#credo una copia del frame e unisco gli slots con un #

			$frame =~ s/\s/\#/g;
			
			if (exists $listaFrames{$frame}) {

				$printFrame = $printFrame."$frame";
				
				print TEMPFRAME "$printFrame\n";
				
				$printFlag = 1;
	
			} else {

				my %subFrames = ();

#aggiungo il frame vuoto (0) come uno dei possibili sottoframes:

				$subFrames{0} = 1;

#trovo tutti i potenziali sottoframes lunghi al piu' 4 slots (combinando i vari slots del frame)

				my @slots = split (/\s/, $_);
				
				my $slotNum = @slots;
			
				my @potentialSubFrames = ();
			
				for (my $i = 0; $i<=$slotNum; $i++) {
					
					push (@potentialSubFrames, $slots[$i]);
					
					for (my $j = $i+1; $j<=$slotNum; $j++) {
						
						my $newFrame2 = "$slots[$i]\#$slots[$j]";
						
						push (@potentialSubFrames, $newFrame2);
						
						for (my $k = $j+1; $k<=$slotNum; $k++) {
							
							my $newFrame3 = "$newFrame2\#$slots[$k]";
							
							push (@potentialSubFrames, $newFrame3);
							
							for (my $z = $k+1; $z<=$slotNum; $z++) {
							
								my $newFrame4 = "$newFrame3\#$slots[$z]";
							
								push (@potentialSubFrames, $newFrame4)
								
							}
							
						}
						
					}
				
				}
				

#verifico quali dei potenziali sottoframes sono attestati nella lista di frames

				foreach my $item (@potentialSubFrames) {

					if (exists $listaFrames{$item}) {
						
						my @matchedFrame = split (/#/, $item);

						my $frameLen = @matchedFrame;
						
						$subFrames{$item} = $frameLen 
					}
				}

#scelgo il sottoframes piu' lungo, e se ce n'e' piu' di uno con la stessa lunghezza, scelgo quello con la freq massima

				my @subFrames = keys %subFrames;
								
				my $subFramesNum = @subFrames;
				
				if ($subFramesNum == 1) {

					$printFrame = $printFrame."$subFrames[0]";
			
					print  TEMPFRAME "$printFrame\n";
					
					$printFlag = 1;

				} else {
	
					my $top = 1;
		
					foreach my $item (sort{ $subFrames{$b}<=>$subFrames{$a} } keys %subFrames) {
						

						if ($item =~ /0/) {
							
							next
							
						} elsif ($top eq 1) {
							
							$top = $item;
							
						} else {

							if ($subFrames{$item}<$subFrames{$top}) {

								$printFrame = $printFrame."$top";

								print TEMPFRAME "$printFrame\n";
								
								$printFlag = 1;

								last

							} elsif ($subFrames{$item} == $subFrames{$top}) {
								
								if ($listaFrames{$item} > $listaFrames{$top}) {
									
									$top = $item;
									
								}
							}
						}
					}
									
	
					unless ($printFlag eq 1) {
							
						$printFrame = $printFrame."$top";

						print TEMPFRAME "$printFrame\n";
								
						$printFlag = 1;

					}

				}
				
			}
			
		} else {
			
			my $frame = $_;
			
			$frame =~ s/\s/\#/g;
			
			$printFrame = $printFrame."$frame";
				
			print TEMPFRAME "$printFrame\n";
				
			$printFlag = 1;
			
		}

	}


#stampo ogni slot e filler del frame (i fillers possono essere piu' di uno, separati da un ;)

	@line = split (/\s+/, $copyFrame);

	my $copyPrintFrame = $printFrame;	
	
	$printFrame =~ s/^.+? //;

	my @frameSlots = split (/\#/, $printFrame);

	my %frameSlots = ();

	foreach my $item (@frameSlots) {

		$frameSlots{$item} = 1

	}
	
	if ($printFlag == 1) {
	
		foreach my $slot (@line) {
		
			$slot =~ s/^(.+?)="(.+?)"$/\1 \2/;
		
			$slot = $1;

			my $fillers = $2;

			my @fillers = split (/;/, $fillers);
		
			if ($slot =~ /^(subj|modadv|modver|modadj)/) {

				foreach my $filler (@fillers) {

					print TEMPFILLER "$copyPrintFrame $slot $filler\n"
				}

			} elsif (exists $frameSlots{$slot}){

				foreach my $filler (@fillers) {
			 	
			 		print TEMPFILLER "$copyPrintFrame $slot $filler\n"
             
             	} 
			}		
		}
	}
}
