Fin de l'extraction des patrons avec Cordial

Publié le 7 avril 2009 par Marion et Sophie

Voici le script qui permet d'extraires les patrons à partir du fichier Cordial :

#/usr/bin/perl #c'est le chibong!!
open (FICCORDIAL, "$ARGV[0]");
open(FILEOUT, ">NomAdjavecCordial");
while (<FICCORDIAL>) { # variable par défaut correspondante : $_
next if ($_!~/\t/); # on saute les lignes dans lesquelles il n'y a rien
my $ligne = $_;
chomp $ligne; # pour enlever le caractère de retour à chaque fin de ligne
if ($ligne!~/PCT/) { # si la ligne ne contient pas de ponctuation
  # MADE IN J-M DAUBE : $ligne=~/(\w+)\t(\w+)\t(\w+)\t/;
  # ATTENTION cette ligne n'est pas satisfaisante pour les mots qui contiennent des espaces !! exemple : au moment de
  # avec la bibliothèque locale (use locale) 'w' aurait aussi contenu les caractères accentués car on se place en France
  @cutcut=split(/\t/, $ligne); #on utilise le fait que les mots sont séparés par des tabulations
  push (@token, $cutcut[0]);
  push (@lemme, $cutcut[1]);
  push (@pos, $cutcut[2]);
  $i++; #ça compte les pos
  }
else {
  #print "@token\n";
  #print "appuie sur return pour continuer\n";
  #my $reponse=<STDIN>;
  open (PATRONS, "$ARGV[1]"); # c'est le fichier des patrons qu'on veut trouver
  while (<PATRONS>) {
   my $patron = $_; # on met dans la variable patron ce qui est contenu dans patrons.txt
   chomp $patron; # pour enlever le caractère de retour à chaque fin de ligne
   $compare=""; # on initialise $compare à vide
   foreach my $element (@pos) { # pour chaque partie du discours
    $compare=$compare."\t".$element; # on met à la suite toutes les parties du discours avec entre deux parties une tabulation
    } # fin de foreach
    # if ($compare =~/$patron/) { # si il y a une correspondance entre le patron et la suite des parties du discours
   my $j = 0;
   my $k = 0;
   while ($compare =~/$patron/g) { #tant qu'on trouve le patron
    $apres=$'; #on met dans $apres le contexte droit
    $avant=$`; #on met dans $avant le contexte gauche
    while ($avant =~/\t/g) {
    $j++;
    }
    while ($apres =~/\t/g) {
    $k++;
    }
    # print "There is a match!\n\n"; # on écrit "There is a match ! "
    print FILEOUT "@token[$j-1..$i-$k-1]\n"; #on prend les mots qui ont les indices compris entre x .. y comme [a..z]
    $j = 0 ;
    $k = 0;
   } # fin de if
  } # fin de while
  close PATRONS; #on ferme PATRONS
  @token=(); #on remet la liste token à zéro
  @lemme=(); #on remet la liste lemme à zéro
  @pos=(); #on remet la liste pos à zéro
  $i=0;
  } # fin de else
} # fin de while

Dans ce script, on redirige la sortie vers un document.

On obtient :

document confidentiel
investiture républicaine
percée inattendue
timbres cutanés et
méthodes alternatives
patients participants à
Tribunal pénal
droit international
promotion fulgurante
Union européenne
capitale irakienne
ressortissante française
police locale
Union africaine
ambition nationale
sociétés françaises
sociétés étrangères
sciences sociales