Script bonus !
Ci-dessous le script extract-terminologie-cordial-v2.pl, proposé par Serge Fleury.
Téléchargement du programme
Téléchargement des résultats. NOM ADJ et NOM PREP NOM.
########## SOLUTION ALTERNATIVE POUR L'EXTRACTION DE PATRONS MORPHO #######################################################
# en entrée : fichiers étiquetés par CORDIAL
# le patron s'écrit en paramètre quand on lance le programme :
# perl extract-terminologie-cordial-v2.pl fichier_étiqueté_cordial patron_elt_1 [...] patron_elt_n
# pour adapter au traitement des fichiers étiquetés par treetagger : lignes 24 et 31 (TT utilise des balises)
# (faire un programme par tache plutot qu'un qui fait les deux en même temps)
###########################################################################################################################
open(FILE,"$ARGV[0]");
my @lignes=; # @lignes = liste qui contient toutes les lignes du fichier étiqueté par Cordial
close(FILE);
while (@lignes) {
my $ligne=shift(@lignes); # sélection du premier élément de la liste + on vide la liste par le haut
chomp $ligne;
my $sequence="";
my $longueur=0;
if ( $ligne =~ /^([^\t]+)\t[^\t]+\t$ARGV[1]/) { # est-ce que la ligne contient le (premier élément du) patron ?
$sequence.=$1; # ajout du token correspondant dans $sequence
$longueur++; # compter le nombre d'éléments qu'on examine
my $indice=1; #indice pour se balader
my $stop=1;
while (($indice < $#ARGV) and ($stop == 1)) { # tant que l'indice reste plus petit que la longueur de ARGV (=le nombre d'éléments de patron +1)
my $nextligne=$lignes[$indice-1]; #ligne suivante
if ( $nextligne =~ /^([^\t]+)\t[^\t]+\t$ARGV[$indice+1]/) { #est-ce que l'élément suivant du patron est là aussi, dans la ligne suivante donc ?
$sequence.=" ".$1; # si oui, on concatène dans $sequence
$longueur++; # on augmente le nombre d'éléments examinés
}
else {
$stop=0;
}
$indice++;
}
if ($longueur == $#ARGV) { # si tous les éléments ont été trouvés
print $sequence,"\n";
}
}
}
Ci-dessous le script extraction-hash-ngram-OK.pl, proposé par Axel Court.
Téléchargement du programme
Téléchargement des résultats. NOM ADJ.
#!/usr/bin/perl
#----------------------------------
# Ouverture des fichiers en lecture
#----------------------------------
open (FICTAG, $ARGV[0]) or die ("probleme sur ouverture de la sortie CORDIAL...");
open (FICPOS, $ARGV[1]) or die ("probleme sur ouverture du fichier des patrons...");
#----------------------------------------------------
# On stocke les patrons dans une table de hachage
#----------------------------------------------------
my %listedespatrons;
my @liste = ();
print "Lecture du fichier de POS\n";
while (my $lignepos = ) {
chomp($lignepos);
my @patron = split(/\#/, $lignepos);
#------------------------------------------------------------------------------------------
# @liste gardera en mémoire le nombre de POS dont est composé chaque patron syntaxique
push(@liste, $#patron+1);
#------------------------------------------------------------------------------------------
$lignepos =~ s/#/ /g;
#-----------------------------------------------------------------------------------------------------------------
# Attention, on stocke des tableaux comme valeurs, donc initialiser ces valeurs à () et non "" !
# Sinon le script stockera la totalité des suites reconnues (soit plus de 10 000) comme valeur de chaque clé !
$listedespatrons{$lignepos} = ();
#-----------------------------------------------------------------------------------------------------------------
}
#------------------------------------------------------------------------------------------------------------------------
# Suppression des doublons de @patron : on obtient des valeurs uniques qui serviront à générer des n-grammes de POS
my %listengramstemp = map { $_, 1 } @liste;
my @listedesngrams = keys %listengramstemp;
#------------------------------------------------------------------------------------------------------------------------
close(FICPOS);
#---------------------------
# Initialisation des listes
#--------------------------
my @malignesegmentee = ();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();
#-------------------------------------------
# Lecture du fichier de tags ligne par ligne
#-------------------------------------------
print "Lecture du fichier a analyser\n";
while (my $ligne = ) {
#-------------------------------------------------------------------------------------
# On ne s'occupe pas des lignes qui ne respectent pas la modèle mot tab mot tab mot
#-------------------------------------------------------------------------------------
if ($ligne =~ /^[^\t]+\t[^\t]+\t[^\t]+$/) {
#-------------------------------------------
# Suppression du caractère de saut de ligne
chomp($ligne);
#-------------------------------------------
# Remplissage des listes
@malignesegmentee = split(/\t/, $ligne);
push(@listedetokens, $malignesegmentee[0]);
push(@listedelemmes, $malignesegmentee[1]);
push(@listedepos, $malignesegmentee[2]);
#-------------------------------------------
}
}
close(FICTAG);
#--------------------------------------------------------------------------------------
# Génération de n-grammes de POS (en fonction du nombre de POS dans les patrons)
# et recherche si chaque n-gramme généré correspond à un patron de %listedespatrons
#--------------------------------------------------------------------------------------
print "Recherche des patrons syntaxiques\n";
foreach my $n (@listedesngrams) {
$n = $n-1;
my $j = 0;
until ($j+$n > $#listedepos) {
my $ngram = join(" ", @listedepos[$j .. $j+$n]);
#-----------------------------------------------------------------
# Si la suite de POS est reconnue comme clé de %listedespatrons
# on stocke les tokens correspondants en valeur du hash
if (exists $listedespatrons{$ngram}) {
my $motsreconnus = join(" ", @listedetokens[$j .. $j+$n]);
push(@{$listedespatrons{$ngram}},$motsreconnus);
#-----------------------------------------------------------------
# $listedespatrons{$ngram} .= "$motsreconnus\n";
}
$j++;
}
}
#-------------------------------------------------
# Impression des résultats de l'extraction
#-------------------------------------------------
my $dump = "";
#-------------------------------------------------
# Parcours de la table de hachage
print "Ecriture des resultats\n";
while ( ($key, $value) = each(%listedespatrons) ) {
$dump .= "------------------------\n";
$dump .= "$key\n-------------------------\n";
#--------------------------------------------------------------
# Parcours du tableau contenant les suites de mots reconnues
# qui correspondent au patron syntaxique (la clé)
foreach my $term (@$value) {
$dump .= $term;
# $dump .= $value;
$dump .= "\n";
#--------------------------------------------------------------
}
$dump .= "\n\n\n";
}
#-------------------------------------------------
open(OUT, ">:encoding(utf8)", "resultat.txt");
print OUT $dump;
close(OUT);
exit;