Version HTML du script extraction-intuitive.pl

Pour télécharger le script : cliquez ici

#/usr/bin/perl
<<DOC; 
Axel COURT & Marjorie SEIZOU
MARS 2010
 usage : perl extraction-intuitive.pl fichier_taggé fichier_motif
DOC

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

# Récupération des arguments 
my $tag_file = $ARGV[0];
my $patterns_file = $ARGV[1];

# Ouverture et lecture des fichiers
open(FILETAG,$tag_file) or die "Pb a l'ouverture du fichier $tag_file : $!";
my @lines=<FILETAG>;
close(FILETAG);

open(FILEPATTERN,$patterns_file) or die "Pb a l'ouverture du fichier $patterns_file : $!";

# initialisation des variables
my @liste_pattern=();
$longueur_pattern = 0;
my %posreconnus;

# on stocke dans la table @liste_pattern les patrons morphosyntaxiques contenus dans le fichier donné en entrée (un par ligne)
foreach $linepattern (<FILEPATTERN>) {
	chomp($linepattern);
	push(@liste_pattern,$linepattern);
}

# pour chacun des patrons de la table
foreach $pattern (@liste_pattern){
	# on découpe et on stocke chacun des POS composant le patron
	@listepos = split(/\s/, $pattern);
	# la longueur du patron correspond à la longueur de la liste (+1 car les tables référencent à partir de 0)
	$longueur_pattern = $#listepos+1;
	
	# appel de la procédure d'extraction des formes correspondants au motif (selon l'extension du fichier en entrée, avec pour paramètre la table des lignes taggées)
	if ($tag_file =~ /.*\.cnr$/) {
	open(OUTPUT, ">:encoding(iso-8859-1)", "resultat_Cordial.txt") or die "Pb a l'ouverture du fichier resultat_Cordial.txt : $!\n";
	&extraction_cordial(@lines);
	}
	elsif ($tag_file =~ /.*\.txt$/) {
	open(OUTPUT, ">:encoding(iso-8859-1)", "resultat_TreeTagger.txt") or die "Pb a l'ouverture du fichier resultat_TreeTagger.txt : $!\n";
	&extraction_treetagger(@lines);
}
	
my $out = "";
# Parcours de la table de hachage
while ( ($key, $value) = each(%posreconnus) ) {
	$out .= "------------------------\n";
	$out .= "$key\n-------------------------\n";
	#--------------------------------------------------------------
	# Parcours du tableau contenant les suites de mots reconnues
	# qui correspondent au patron syntaxique (la clé)
	foreach my $term (@$value) {
		$out .= $term;
		$out .= "\n";
	#--------------------------------------------------------------
	}
	$out .= "\n\n\n";
}
	print OUTPUT $out;
	
	close(OUTPUT);
}
close(FILEPATTERN);

# Extraction TreeTagger
sub extraction_treetagger {
# on récupère le contenu du fichier taggé passé en paramètre dans la table locale @lines (vidée à chaque traitement du fait de la fonction 'shift()')
my @lines=@_;

# Parcours du fichier taggé (une forme par ligne : forme /t POS /t lemme)
while (@lines) {
	# (ré-)initialisation du compteur de lignes
	$i = 0;
	my $line=shift(@lines);
	chomp $line;
	# initialisation de la variable qui contiendra le motif correspondant au patron recherché
	my $motif="";
	# Intialisation d'un compteur de POS
	$j = 0;
	
	# on recherche le premier POS du patron et on en extrait la forme que l'on stocke dans $motif
	if ($line =~ /(.+?)\t($listepos[$j].*?)\t(.+?)/) {
		my $token = $1;
		$motif .= $token;
		# on incrémente le compteur de lignes pour passer à la ligne suivante et continuer la recherche
		$i++;
		# on incrémente le compteur de POS pour rechercher le POS suivant (qui correspondra alors aussi à $j)
		$j++;

		# si l'on a trouvé le premier POS, on continue la recherche jusqu'à ce que le patron soit lu en entier ($longueur_pattern-1 puisque $j initialisé à 0)
		while ( $j <= ($longueur_pattern-1) ) {	
			# si l'on trouve le(s) POS suivant(s), la même procédure est appliquée (on stocke la forme correspondante dans $motif précédée d'un espace)
			# la recherche de la ligne suivante est faite à partir de la table contenant toutes les lignes : 
			# la fonction 'shift' retournant et supprimant le premier élément d'une table (ici, la ligne où le 1er POS a été trouvé), 
			# et que l'on incrémente le compteur à chaque POS correct trouvé par la suite, la ligne suivante correspond à $i-1
			if ($lines[$i-1] =~ /(.+?)\t($listepos[$j].*?)\t(.+?)/) {
				my $token = $1;
				$motif .= " ".$token;
				$i++;
				$j++;
				
			}
			# Pour arrêter la boucle si jamais le POS trouvé sur la ligne suivante ne correspond pas 
			# ($longueur_pattern+1 pour qu'il ne soit pas imprimé et passer à une nouvelle recherche)
			else { $j=$longueur_pattern+1; }
		}
		# on imprime le motif récupéré lorsque les POS du patron ont tous été trouvés 
		# (la longueur du motif est donc la même que $longueur_pattern calculée précédemment)
		$lm = split(/\s/, $motif);
		if ($lm==$longueur_pattern) {
			push(@{$posreconnus{$pattern}},$motif);
		}

}
}
}

# Extraction Cordial
sub extraction_cordial {
# on récupère le contenu du fichier taggé passé en paramètre dans la table locale @lines (vidée à chaque traitement du fait de la fonction 'shift()')
my @lines=@_;

# Parcours du fichier taggé (une forme par ligne : forme /t lemme /t POS)
while (@lines) {
	# (ré-)initialisation du compteur de lignes (de la liste @lines)
	$i = 0;
	my $line=shift(@lines);
	chomp $line;
	# initialisation de la variable qui contiendra le motif correspondant au patron recherché
	my $motif="";
	# Intialisation d'un compteur de POS
	$j = 0;
	
	# on recherche le premier POS du patron et on en extrait la forme que l'on stocke dans $motif
	if ($line =~ /(.+?)\t(.+?)\t($listepos[$j].*?)/) {
		my $token = $1;
		$motif .= $token;
		# on incrémente le compteur de lignes pour passer à la ligne suivante et continuer la recherche
		$i++;
		# on incrémente le compteur de POS pour rechercher le POS suivant (qui correspondra alors aussi à $j)
		$j++;
		
		# si l'on a trouvé le premier POS, on continue la recherche jusqu'à ce que le patron soit lu en entier ($longueur_pattern-1 puisque $j initialisé à 0)
		while ( $j <= ($longueur_pattern-1) ) {	
			# si l'on trouve le(s) POS suivant(s), la même procédure est appliquée (on stocke la forme correspondante dans $motif précédée d'un espace)
			# la recherche de la ligne suivante est faite à partir de la table contenant toutes les lignes : 
			# la fonction 'shift' retournant et supprimant le premier élément d'une table (ici, la ligne où le 1er POS a été trouvé), 
			# et que l'on incrémente le compteur à chaque POS correct trouvé par la suite, la ligne suivante correspond à $i-1
			if ($lines[$i-1] =~ /(.+?)\t(.+?)\t($listepos[$j].*?)/) {
				my $token = $1;
				$motif .= " ".$token;
				$i++;
				$j++;
				
			}
			# Pour arrêter la boucle si jamais le POS trouvé sur la ligne suivante ne correspond pas 
			# ($longueur_pattern+1 pour qu'il ne soit pas imprimé et passer à une nouvelle recherche)
			else { $j=$longueur_pattern+1; }
		}
		# on imprime le motif récupéré lorsque les POS du patron ont tous été trouvés 
		# (la longueur du motif est donc la même que $longueur_pattern calculée précédemment)
		$lm = split(/\s/, $motif);
		if ($lm==$longueur_pattern) {
			push(@{$posreconnus{$pattern}},$motif);
		}

}
}
}