#!/usr/bin/perl
#--------------------------------------------------------------------------------------------------------------------------------------------------------

# SEGHIER Marina
# BAO3bis "extraction de patrons" : recherche et extraction de relations de dépendances (cf Cours Documents Structurés)

#--------------------------------------------------------------------------------------------------------------------------------------------------------

# Pour lancer le script : perl bao3bis.pl fichier_UDPipe.xml obj(ou nsubj) > corpus.txt
# 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 utf8;
binmode STDOUT, ':utf8';
#-------------------------------------------------------------------------------------
my $rep="$ARGV[0]"; # on stocke dans la variable rep le script (1er argument de la commande)
my $relation="$ARGV[1]"; # on stocke dans la variable relation le dossier (2e argument de la commande)
my %dicoRelation=(); # on crée un dictionnaire vide qui va contenir les relations
#-------------------------------------------------------------------------------------
$/="</p>"; # on découpe le texte par phrase (liste d'items annotés et potentiellement dépendants)
open my $IN ,"<:encoding(utf8)","$ARGV[0]"; # on ouvre le fichier
while (my $phrase=<$IN>) { # boucle tant que
	#-------------------------------------------------------------------------------------
	my @LIGNES=split(/\n/,$phrase); # on traite chaque "paragraphe" en le découpant par "items"
	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]=~/<item><a>([^<]+)<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>([^<]+)<\/a><a>[^<]*$relation[^<]*<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/i) {
			my $posDep=$1; 
			my $posGouv=$3;
			my $formeDep=$2;
			# soit le gouv est avant le dep, soit après...
			if ($posDep > $posGouv) { # si le gouverneur est avant la ligne traitée (= position du dépendant > à celle du gouverneur)
				for (my $k=0;$k<$i;$k++) {
					if ($LIGNES[$k]=~/<item><a>$posGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						my $formeGouv=$1;
						$dicoRelation{"$formeGouv $formeDep"}++; # on ajoute la relation au dictionnaire
					}
				}
			}
			else { # ou avec les lignes précédentes
				for (my $k=$i+1;$k<=$#LIGNES;$k++) {
					if ($LIGNES[$k]=~/<item><a>$posGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
						my $formeGouv=$1;
						$dicoRelation{"$formeGouv $formeDep"}++; # on ajoute la relation au dictionnaire
					}
				}
			}
		}
	}
}
close ($IN); # on ferme le fichier
# on imprime la liste des couples Gouv,Dep et leur fréquence dans une boucle for each
foreach my $relation (sort {$dicoRelation{$b}<=>$dicoRelation{$a}} (keys %dicoRelation)) {
	print "$relation\t$dicoRelation{$relation}\n";
}
