Boite à outils 3: extraction de patrons (avec perl)

Présentation

Le programme se lance de la façon suivante :

perl bao3.pl nomfichier.cnr patrons.txt| sort | uniq -c | sort -r > nom-sortie.txt 

Notre fichier patrons.txt est composé de trois lignes:

NC.. PREP NC..

ADJ.. NC..

NC.. ADJ..

qui nous permettent d'extraire les nom/prep/nom, nom/adj et adj/nom.

Grâce aux arguments présents dans la ligne de commande, nous obtenons un fichier de sortie avec les patrons précedents extraits classés dans l'ordre du plus fréquent au moins fréquent, avec également leur nombre d'occurences.

Le programme

BAO3.pl

Le fichier des patrons

Le script

#!/usr/bin/perl
use utf8;
binmode STDOUT,":utf8";
# Programme d'extraction de patron
# sur sortie Cordial

# Usage : perl bao3.pl nomfichier.cnr patrons.txt| sort | uniq -c | sort -r > nom-sortie.txt

#--------------------------------------------------------------------
open(FIC,"<:encoding(ISO-8859-1)",$ARGV[0]);
my $chaine="";
while (my $ligne=<FIC>) {
    chomp $ligne;
    if (($ligne=~/^([^\t]+)\t[^\t]+\t([^\t]+)$/) and ($ligne!~/PCTFORTE/)) {   
        my $f=$1;
        my $c=$2;
        $f=~s/ /#/g;
        $chaine = $chaine . $c."_".$f." ";
    }
    else {
        open(TERM,"<:encoding(utf8)",$ARGV[1]);
        while (my $terme=<TERM>) {
            chomp($terme);
            #$terme=~s/([A-Z]+)/$1_\[\^ \]+/g;		# avec cette RegEx, on est obligé d'écrire totalement les patrons
            $terme=~s/([^ ]+)/$1_\[\^ \]+/g;		#les patrons sont plus simple et sur deux lignes seulement
            while($chaine=~/($terme)/g) {
                my $correspondance=$&;
                $correspondance=~s/[A-Z]+_//g;
				$correspondance=~s/#/ /g;
				print $correspondance, "\n";
            }
        }
        close(TERM);
        $chaine="";
    }
}
close(FIC);