#!/usr/bin/perl

<<DOC; 
Noms : PHOMMADY Elodie & AOUES Nora
Usage : perl ./BAO3/Perl/BAO3_ExtractionPatrons_UDPipe.pl numero_rubrique
    Placé sur le répertoire de travail ProjetEncadré, le programme est lancé 
    en prennant en entrée  le numéro de la rubrique à traiter 
DOC


#***********************************************************
#**************** PROGRAMME PRINCIPAL **********************

#-----------------------------------------------------------
# UTILISATION DE BILIOTHEQUES 

use strict;
use utf8;

#-----------------------------------------------------------
# RECUPERATION DES PATRONS MORPHO-SYNTAXIQUES

open my $termino, "./BAO3/Perl/patrons_UDPipe.txt";
my @patrons=<$termino>;
close $termino;

#-----------------------------------------------------------
# EXTRACTION DES SEQUENCES CORRESPONDANT AUX PATRONS 

# Création de la table de hashage qui va contenir toutes les séquences de mots
my %dict=();

# Lecture du fichier annoté 
my $rubrique="$ARGV[0]";
open my $input, "<:encoding(utf8)", "./Resultats/Sorties_BAO2/sortieudpipe-slurp_$rubrique.txt";
my @pos=();
my @token=();

# Ouverture du fichier de sortie
open my $output, ">:encoding(utf8)", "./Resultats/Sorties_BAO3_Perl/Sorties_patrons/udpipe/sortieudpipe-patrons_$rubrique.txt";

# Pour chaque ligne du fichier étiqueté
while (my $ligne=<$input>) {
	
	# Ne pas s'occuper des lignes :
	#   - commençant par un dièse (donc les premières lignes du fichier annoté)
	#   - qui traite les formes contractées (par ex. "au" au lieu de "à" + "le")
	next if $ligne=~m/^#|\d+-\d+/ ;
	
	# Supprimer les lignes qui ne continnent aucune donnée
	$ligne=~s/\r?\n//g;
	
	# Lecture de chaque ligne non vide 
	if ($ligne ne "") {
		my @ligne = split(/\t/, $ligne);
		# Récupération des tokens et leurs POS associées uniquement
		push(@token, $ligne[1]);
		push(@pos, $ligne[3]);
	}
	
	else {
		
		# Pour chaque patron de la liste des patrons
		foreach my $suitedepos (@patrons) {
			
			# Initialisation de la longueur du patron
			my $long=0;
			
			# Supprimer les lignes qui ne continnent aucun patron
			$suitedepos=~s/\r?\n//g;
			
			# Compte les espaces (blancs) dans le patron : Prend en compte la longueur du patron 
			# pour s'assurer qu'on ne récupère que les tokens correpondant au patron et pas les tokens qui suivent
			while ($suitedepos=~/ /g) {$long++}
			my $i=0;
			
			# Pour chaque POS récupéré dans le fichier annoté
			foreach my $element (@pos) {
				$i++;
				
				# Vérification : le POS courant est le début d'un patron 
				if ($suitedepos =~/^$element/) {
					
					# Récupère toute la séquence de POS à partir du POS courant sur la longueur $long du patron
					my $suite="";
                    my $j=0;
					for ($j=$i-1;$j<=$long+$i-1;$j++) {$suite=$suite.$pos[$j]." "}
					
					# Vérification : Séquence récupérée correspond à celle du patron
					if ($suite=~/$suitedepos/) {
						
						# Extraction des tokens associés
						my $extract = join(" ", @token[$i-1..$j-1]);
						# Ajout de toutes les extractions (en minuscule) dans une table de hashage
						$dict{lc($extract)}++;
						#print "$extract\n";
					}
				}
			}
		}
			
		# Réinitialisation des lignes en les vidant 
		@pos=();
		@token=();
	}
	
}

close $input;

#-----------------------------------------------------------
# IMPRIMER LA TABLE DE HASHAGE CONTENANT LES EXTRACTIONS PAR ORDRE DE FREQUENCE DECROISSANT

foreach my $cle (sort { $dict{$b} <=> $dict{$a} } keys %dict) {
	print $output "$cle : $dict{$cle}\n";
}

#-----------------------------------------------------------
# FERMETURE DU FICHIER DE SORTIE
close $output;