#!/usr/bin/perl
<<DOC; 
Nom -- Elise LINCKER
Date -- AVRIL 2021

Traitement -- extraction de dépendances syntaxiques
              séquences Dep1 Gouv Dep2, pour 2 relations et un même gouverneur
              Dep1 <- Gouv -> Dep2

Utilisation du programme -- perl bao3_extract_dep_2dep1gouv_udpipexml.pl FICHIER_A_TRAITER "RELATION1" "RELATION2"
Exemple d'utilisation -- perl bao3_extract_dep_2dep1gouv_udpipexml.pl BAO2_sortieUDpipe_3214.txt.xml "nsubj" "obj" > ./sorties_dep/BAO3_sortie_Perl_SVO_3214.txt
Entrée -- le nom de la sortie UDPipe reformatée en XML
          le nom de la première relation de dépendances
          le nom de la deuxième relation de dépendances
Sortie -- la liste triée des triplets Dep1 Gouv Dep2 de la relation

Remarque -- selon les relations, on voudra changer l'ordre d'affichage des résultats
            Gouv Dep1 Dep2 / Dep1 Gouv Dep2 / Dep2 Gouv Dep1 ...etc, lignes 76 et 85
DOC

use strict;
use utf8;
binmode STDOUT, ':utf8';

#---------------------------------------------------------------------------------
my $fichier="$ARGV[0]";
my $relation1="$ARGV[1]";
my $relation2="$ARGV[2]";
my %dicoRelation=();

#---------------------------------------------------------------------------------
#on découpe le texte par phrase (1 phrase par balise <p>)
$/="</p>"; 			
open my $IN ,"<:encoding(utf8)","$fichier";
while (my $phrase=<$IN>) {

	#-----------------------------------------------------------------------------
	# on transforme la phrase récupérée en une liste d'items : 1 ligne = 1 balise <item>
	#il suffit de segmenter les phrases avec le caractère de retour à la ligne car on a déjà 1 item par ligne dans le fichier
	my @LIGNES=split(/\n/,$phrase);

	#pour chaque ligne = item :
	for (my $i=0;$i<=$#LIGNES;$i++) {

		#on utilise les expressions régulières pour tester :
		#	si la 8e balise <a> contient la chaîne de caractères dans $relation1
		#et, le cas échéant, pour récupérer :
		#	dans la variable $formeDep1 la forme du dépendant 1
		#	dans la variable $positionDep2 la position du dépendant 1
		#	dans la variable $positionGouv la position du gouverneur
		if ($LIGNES[$i]=~/<item><a>([^<]+)<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>([^<]+)<\/a><a>[^<]*$relation1[^<]*<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/i) {
			my $formeDep1=$2;
			my $positionDep1=$1;
			my $positionGouv=$3;

			#on utilise les expressions régulières pour tester si il existe un autre item dans la phrase pour lequel :
			#	la 8e balise <a> contient la chaîne de caractères dans $relation2
			#	la 7e balise <a> contient le contenu de la variable $positionGouv
			#	<=> l'item est gouverné par une relation obj et son gouverneur est le même que celui de Dep1
			#et, le cas échéant, pour récupérer :
			#	dans la variable $formeDep2 la forme du dépendant 2
			for (my $j=0;$j<=$#LIGNES;$j++) {
				if ($LIGNES[$j]=~/<item><a>[^<]*<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>$positionGouv<\/a><a>[^<]*$relation2[^<]*<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
					my $formeDep2=$1;

					#si on a bien récupéré deux items ayant le même gouverneur
					#alors, en fonction de la position du gouverneur par rapport au dépendant 1 (avant ou après) 
					#on récupère dans la variable $formeGouv la forme du gouverneur
					#puis on ajoute à $dicoRelation la concaténation : forme dep1 + espace + forme gouv + espace + forme dep2
					#!!! cet ordre peut être modifié selon le résultat attendu !!!
					if ($positionDep1 > $positionGouv) {
						#si le gouverneur est avant le dépendant 1 : on cherche le gouverneur parmi les lignes d'indice entre 0 et i
						for (my $k=0; $k<$i; $k++) {
							if ($LIGNES[$k]=~/<item><a>$positionGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
								my $formeGouv=$1;
								$dicoRelation{"$formeDep1 $formeGouv $formeDep2"}++;
							}
						}
					}
					else {
						#si le gouverneur est après le dépendant 1 : on cherche le gouverneur parmi la ligne d'indice i+1 et la fin de la liste
						for (my $k=$i+1; $k<=$#LIGNES; $k++) {
							if ($LIGNES[$k]=~/<item><a>$positionGouv<\/a><a>([^<]+)<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><a>[^<]+<\/a><\/item>/) {
								my $formeGouv=$1;
								$dicoRelation{"$formeDep1 $formeGouv $formeDep2"}++;
							}
						}
					}
				}
			}			
		}
	}
}
close ($IN);

#on affiche la liste des triplets Dep1 Gouv Dep2 et leur nombre d'occurrences
foreach my $relation (sort {$dicoRelation{$b}<=>$dicoRelation{$a}} (keys %dicoRelation)) {
	print "$relation\t$dicoRelation{$relation}\n";
}