Version HTML du script extraction-ngram.pl

Pour télécharger le script : cliquez ici

#!/usr/bin/perl

<<DOC; 
Axel COURT & Marjorie SEIZOU
MARS 2010
 usage : perl extraction-ngram.pl fichier_taggé fichier_motif
DOC

# Test des paramètres
if($#ARGV!=1){
	print "usage : perl $0 fichier_tagge fichier_motif\n";
	exit;
}

#----------------------------------
# Ouverture des fichiers en lecture
#----------------------------------
open (FICTAG, $ARGV[0]) or die ("Probleme sur ouverture du fichier de tags : $!\n");
open (FICPOS, $ARGV[1]) or die ("Probleme sur ouverture du fichier des patrons : $!\n");
#----------------------------------------------------
# On stocke les patrons dans une table de hachage
#----------------------------------------------------
my %listedespatrons;
my @liste = ();
print "Lecture du fichier de POS\n";
while (my $lignepos = <FICPOS>) {
    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);
	#------------------------------------------------------------------------------------------
	# 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";

# On détermine si le fichier de tags passé en argument est un fichier TreeTagger ou Cordial
# Pour cela, on se base sur l'extension du fichier : on part du principe qu'un fichier Cordial est un fichier .cnr
# et un fichier TT est un fichier .txt classique
my $programme = "";
if ($ARGV[0] =~ /.*\.cnr$/) {
	$programme = "Cordial";
}
elsif ($ARGV[0] =~ /.*\.txt$/) {
	$programme = "TreeTagger";
}

while (my $ligne = <FICTAG>) {
    #-------------------------------------------------------------------------------------
    # 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);
	if ($programme eq "Cordial") {
		push(@listedetokens, $malignesegmentee[0]);
		push(@listedelemmes, $malignesegmentee[1]);
		push(@listedepos, $malignesegmentee[2]);
	}
	elsif ($programme eq "TreeTagger") {
		push(@listedetokens, $malignesegmentee[0]);
		push(@listedelemmes, $malignesegmentee[2]);
		push(@listedepos, $malignesegmentee[1]);
	}
	#-------------------------------------------
    }
}
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);
		#-----------------------------------------------------------------
		}
		$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) ) {
	if ($value ne "") {
		$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 .= "\n";
		#--------------------------------------------------------------
		}
		$dump .= "\n\n\n";
	}
}
#-------------------------------------------------

open(OUT, ">:encoding(iso-8859-1)", "resultat_$programme.txt");
print OUT $dump;
close(OUT);
exit;