#!/usr/bin/perl
#----------------------------------------------------------------------------------
# MODE D EMPLOI : perl extract-relation-udpipe.pl sortieudpipe-slurp_3208.xml "obj"
# En entrée : sortie UDPIPE formatée en XML + une relation syntaxique
# En sortie la liste triée des couples Gouv,Dep en relation
#----------------------------------------------------------------------------------
use strict;
use utf8;
binmode STDOUT,':utf8';
#-------------------------------------------------------------------------------------
#fichier udpipe
my $rep="$ARGV[0]";
#relation à chercher
my $relation="$ARGV[1]";
#fonction pour ajouter une ligne vide et pouvoir échapper la division en phrase 
#ainsi on pourra réinitialiser la variable $/(séparateur en phrase) en mode "paragraphe"
#deux paragraphes sont par défaut considéré séparés s'il y a des lignes vides entre les deux
&lignevide;
#création dico pour le comtpage
my %dicoRelation=();
#réinitialisation de la variable pour la division en paragraphes du texte 
#dans ce cas, à cause de l'annotation, ceux que perl cosidère paragraphes 
#sont en vérité mes phrases
$/=""; 
#-------------------------------------------------------------------------------------	
#ouverture du fichier propre
open my $IN ,"<:encoding(utf8)","UPpourrelation.xml";
#on va lire les phrases une par une
while (my $phrase=<$IN>) {
	#-------------------------------------------------------------------------------------
	# on traite chaque "paragraphe" en le decoupant en "elements"
	my @LIGNES=split(/\n/,$phrase);
	for (my $i=0;$i<=$#LIGNES;$i++) {
		# si la ligne lue contient la relation, on ira chercher le dep puis le gouv
		if ($LIGNES[$i]=~/<element><data type='id'>([^<]+)<\/data><data type='type'>[^<]+<\/data><data type='lemma'>[^<]+<\/data><data type='string'>([^<]+)<\/data><data type='rel'>[^<]*$relation[^<]*<\/data><data type='gouv'>([^<]+)<\/data><\/element>/i) {
			#extraction de la position du dépendant, la position du gouverneur et la forme du dépendant 
			#je pourrai insérer ici le filtre (p.e. en disant "je le prends en cosidération seulement si le POS est NOM)
			my $posDep=$1;
			my $posGouv=$3;
			my $formeDep=$2;
			#si le gouverneur se trouve avant le dépendant:
			if ($posDep > $posGouv) {
				#boucle qui va se terminer à la valeur de $i
				for (my $k=0;$k<$i;$k++) {
					if ($LIGNES[$k]=~/<element><data type='id'>$posGouv<\/data><data type='type'>[^<]+<\/data><data type='lemma'>[^<]+<\/data><data type='string'>([^<]+)<\/data><data type='rel'>[^<]+<\/data><data type='gouv'>[^<]+<\/data><\/element>/) {
						my $formeGouv=$1;
						#ajouter la forme au dico
						$dicoRelation{"$formeGouv $formeDep"}++;
					}
				}
			}
			#si le gouverneur se trouve après le dépendant
			else {
				#boucle qui part de $i et va se terminer à la fin du titre/description
				for (my $k=$i+1;$k<=$#LIGNES;$k++) {
					if ($LIGNES[$k]=~/<element><data type='id'>$posGouv<\/data><data type='type'>[^<]+<\/data><data type='lemma'>[^<]+<\/data><data type='string'>([^<]+)<\/data><data type='rel'>[^<]+<\/data><data type='gouv'>[^<]+<\/data><\/element>/) {
						my $formeGouv=$1;
						#ajout au dictionnaire
						$dicoRelation{"$formeGouv $formeDep"}++;
					}
				}
			}
		}
	}
}
close ($IN);
# on imprime la liste des couples Gouv,Dep et leur fréquence...
open my $fileResu,">:encoding(UTF-8)","$relation.txt";
foreach my $relation (sort {$dicoRelation{$b}<=>$dicoRelation{$a}} (keys %dicoRelation)) {
	print $fileResu "$dicoRelation{$relation}\t$relation\n"
}
close($fileResu);
print("FINITO");
###########################################################################################
#FONCTIONS:
#fonction pour ajouter une ligne vide à la fin de chaque titre ou description pour aider le découpage
sub lignevide {
	#ouverture du fichier input
	open my $input ,"<:encoding(utf8)",$rep;
	#ouverture fichier output
	open my $output,">:encoding(UTF-8)","UPpourrelation.xml";
	#lecture intégrale du fichier
	while (my $phrase=<$input>){
		#si la ligne indique la fin d'une phrase 
		if ($phrase=~/(<\/titre><description>|<\/description><\/item>)/){
			my $newphrase=$1;
			#print cette ligne avec un retour à la ligne en plus
			print $output "$newphrase\n\n";
		}
		else {
			#sinon imprimer la phrase comme elle était
			print $output $phrase;
		}
	}
close($input);
close($output);
}