Projet Encadré S2

Fiche technique du script :
TRAITEMENT DE L'ETIQUETAGE DE CORDIAL
Premier argument du programme : le fichier cordial
Deuxième argument du programme : le fichier patron
SORTIE : fichiers textes comprenant les patrons extraits

#!/usr/bin/env perl
# perl -c 
# creation d'un fichier de sortie
print "Bonjour ! Veuillez choisir un nom de fichier pour contenir patrons extraits :\n";
my $fic=;
open(FIC1, ">$fic");
# creation des listes pour le contenu 
my @LISTETOKEN;
my @LISTELEMME;
my @LISTEETIQUETTE;
#--------------------------------------------------
# lecture du fichier PATRON 
# 2e arg : fichier motif, on lit le fichier 
open(PATRON, "$ARGV[1]"); 
# a chaque condition de la liste on met le contenu dans une position de la liste : lecture globale du fichier au lieu de ligne a ligne 
my @LISTEPATRON=;
close (PATRON);
# 1er arg : fichier cordial 
open (CORDIAL, "$ARGV[0]");
# on lit chaque ligne et on s'arrete au ponctuation
# lecture du fichier ligne a ligne 
while(my $ligne=){
  # avant de traiter la ligne, on enleve les retours a la ligne 
  $ligne=~s/\r//;
  chomp($ligne);
  # debut de ligne tout sauf une tabulation 
  # format des lignes qui nous interessent : 
  # ^[^\t]+\t[^\t]+\t[^\t]+$
  # on met des parentheses pour capturer les ensembles dans $1 $2 $3 que l'on mettra dans des listes
  if ($ligne =~/^([^\t]+)\t([^\t]+)\t([^\t]+)$/) {
    # creation des variables
    # my ($token, $lemme, $etiquette) = ($1, $2, $3);
    my $token = $1;
    my $lemme = $2;
    my $etiquette = $3;
    #print $ligne;
    # si l'etiquete ne contient pas de ponctuation forte 
    if ($etiquette!~/^PCTF/){
      # on enregistre les contenus dans les listes correspondantes
      # push : rajoute des elements a la fin d'une liste 
      push(@LISTETOKEN, $token);
      push(@LISTELEMME, $lemme);
      push(@LISTEETIQUETTE, $etiquette);
    }
    # si on tombe sur des ponctuations on compare avec le fichier motif 
    else {
      # on transforme les listes en scalaire (pointeur vers une liste) : creation d'une reference 
      &compare(\@LISTETOKEN,\@LISTEETIQUETTE);
      # on purge les listes  
      @LISTEETIQUETTE=();
      @LISTETOKEN=();
      @LISTELEMME=();
    }
  }
}
# --------------------------
# comparaison des listes avec les lignes de motifs 
# il faudra transformer la liste d'etiquette en scalaire 
sub compare {
  # on dereference les scalaires pour qu'elles redeviennent des listes 
  my ($first, $second)=@_;
  my @LISTETOKEN=@$first;
  my @LISTEETIQUETTE=@$second;
  #print "Liste des token : @LISTETOKEN\n";
  #print "Liste des etiquettes des token: @LISTEETIQUETTE \n";
  #print "------------------------------------------\n";
  # pour chaque patron dans la liste LISTEPATRON
  foreach my $patron (@LISTEPATRON) {
    $patron=~s/\r//;
    chomp $patron;
    #print "Patron en cours : $patron \n";
    #print "------------------------------------------\n";
    # chercher dans la liste des etiquettes si on trouve $patron 
    # transformation d'une liste en scalaire 
    my $texte_des_etiquettes=join(" ",@LISTEETIQUETTE);
    # tant que le scalaire des etiquettes contient $patron : 
    while ($texte_des_etiquettes=~/$patron/g) {
      # on veut savoir combien il y a de blancs dans le contexte fauche de la zone de correspondance
      my $contextebefore=$` ;
      # print "CB: ",$contextebefore,"\n";
      my $compteurblanc=0;
      while ($contextebefore=~/\t/g) {
        $compteurblanc++;
      }
    my @MONPATRONENCOURS=split(/ /, $patron);
    # obtenir la valeur 
    my $longueurpatron=$#MONPATRONENCOURS;
    my $bornsup=$compteurblanc + $longueurpatron;
    # .. "jusqu'à"
    print "@LISTETOKEN[$compteurblanc..$bornsup]\n";
    print FIC1 "@LISTETOKEN[$compteurblanc..$bornsup]\n";
    print "------------------------------------------\n";
    # my $rep=;
    }
  }
}

Fiche technique du script :
TRAITEMENT DE LA SURFACE

Lancement du programme depuis le terminal (MACOSX):
/usr/local/ActivePerl-5.16/bin/perl ScriptRH.pl 3208.xml patrons.txt

ENTREE : fichiers xml étiquetés en BAO2
SORTIE : fichiers txt comprenant les patrons extraits

#/usr/bin/perl
<new(XML_LIBXML_RECOVER => 2);
$xp->recover_silently(1);

# enregistrement du fichier XML dans la RAM : pb de saturation de la mémoire
my $dom    = $xp->load_xml( location => $tag_file );
# recupération élément racine: partir directement de l'article peut etre plus économique et faire une boucle 
my $root   = $dom->getDocumentElement();

# contruction de l'objet XPATH contexte, instancié à partir de l'élément root. 
# ouverture du fichier qui contient les motifs 
# pour chaque ligne il me faut faire ma recherche de forme 
my $xpc    = XML::LibXML::XPathContext->new($root);

# Ouverture du fichiers de motifs
open(PATTERNSFILE, $patterns_file) or die "can't open $patterns_file: $!\n";

# Boucle pour lire les lignes des motifs lecture du fichier contenant les motifs, un motif par ligne (par exemple : NOM ADJ)
while (my $ligne = ) {
  # Appel à  la procédure d'extraction des motifs
  &extract_pattern($ligne);
}

# Fermeture du fichiers de motifs
close(PATTERNSFILE);

# routine de construction des chemins XPath
sub construit_XPath{
  # On récupère la ligne du motif recherché
  my $local_ligne=shift @_;
  
  # initialisation du chemin XPath
  my $search_path="";
  
  # on supprime avec la fonction chomp un éventuel retour à la ligne
  chomp($local_ligne);
  
  # on élimine un éveltuel retour chariot hérité de windows
  $local_ligne=~ s/\r$//;
  
  # Construction au moyen de la fonction split d'un tableau dont chaque élément a pour valeur un élément du motif recherché
  my @tokens=split(/\s+/,$local_ligne);
  
  # On commence ici la construction du chemin XPath
  # Ce chemin correspond au premier noeud "element" de l'arbre XML qui répond au motif cherché 
  $search_path="//element[contains(data[\@type=\"type\"],\"$tokens[0]\")]";
  
  # Initialisation du compteur pour la boucle de construction du chemin XPath
  # gestion de la variabilité du nombre d'éléments par ligne dans le fichier motif
  my $i=1;
  while ($i < $#tokens) {
    # concaténation de following sibling
    $search_path.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"$tokens[$i]\")]";
    $i++;
  }

  my $search_path_suffix="]";
  
  # on utilise l'opérateur x qui permet de répéter la chaine de caractère à sa gauche autant de fois que l'entier à sa droite,
  # soit $i fois $search_path_suffix
  $search_path_suffix=$search_path_suffix x $i;
  
  # le chemin XPath final
  # .= concaténation 
  $search_path.="[following-sibling::element[1][contains(data[\@type=\"type\"],\"".$tokens[$#tokens]."\")]"
                .$search_path_suffix;
    # print  "$search_path\n";

  # on renvoie à la procédure appelante le chemin XPath et le tableau des éléments du motif
  return ($search_path,@tokens);
}

# routine d'extraction du motif
sub extract_pattern{
  # On récupère la ligne du motif recherché
  #@_ = @ARGV dans une fonction
  my $ext_pat_ligne= shift @_;

  # Appel de la fonction construit_XPath pour le motif lu à la ligne courrante du fichier de motif
  my ($search_path,@tokens) = &construit_XPath($ext_pat_ligne);
  
  # définition du nom du fichier de résultats pour le motif en utilisant la fonction join
  my $match_file = "res_extract-".join('_', @tokens).".txt";

  # Ouverture du fichiers de résultats encodé en UTF-8
  open(MATCHFILE,">:encoding(UTF-8)", "$match_file") or die "can't open $match_file: $!\n";
  
  # création de l'objet XML::XPath pour explorer le fichier de sortie tree-tagger XML
  
  # Parcours des noeuds du ficher XML correspondant au motif, au moyen de la méthode findnodes
  # qui prend pour argument le chemin XPath construit précédement
  # avec la fonction "construit_XPath"
  my @nodes=$root->findnodes($search_path);
  foreach my $noeud ( @nodes) {
    # Initialisation du chemin XPath relatif du noeud "data" contenant
    # la forme correspondant au premier élément du motif
    # Ce chemin est relatif au premier noeud "element" du bloc retourné
    # et pointe sur le troisième noeud "data" fils du noeud "element"
    # en l'identifiant par la valeur "string" de son attribut "type"
    my $form_xpath="";
    $form_xpath="./data[\@type=\"string\"]";
    
    # Initialisation du compteur pour la boucle d'éxtraction des formes correspondants
    # aux éléments suivants du motif
    my $following=0;

    # Recherche du noeud data contenant la forme correspondant au premier élément du motif    
    # au moyen de la fonction "find" qui prend pour arguments:
    #     1. le chemin XPath relatif du noeud "data"
    #     2. le noeud en cours de traitement dans cette boucle foreach
    # la fonction "find" retourne par défaut une liste de noeuds, dans notre cas cette liste
    # ne contient qu'un seul élément que nous récupérons avec la fonction "get_node"
    # enfin nous en imprimons le contenu textuel au moyen de la méthode string_value
    print MATCHFILE $xpc->findvalue($form_xpath,$noeud);
    
    # Boucle d'éxtraction des formes correspondants aux éléments suivants du motif
    # On descend dans chaque noeud element du bloc
    while ( $following < $#tokens) {
      # Incrémentation du compteur $following de cette boucle d'éxtraction des formes
      $following++;
      
      # Construction du chemin XPath relatif du noeud "data" contenant
      # la forme correspondant à l'élément suivant du motif
      # Notez bien l'utilisation du compteur $folowing tant dans la condition de la boucle ci-dessus
      # que dans la construction du chemin relatif XPath
      my $following_elmt="following-sibling::element[".$following."]";      
      $form_xpath=$following_elmt."/data[\@type=\"string\"]";

      # Impression du contenu textuel du noeud data contenant la forme correspondant à l'élément suivant du motif
      print MATCHFILE " ",$xpc->findvalue($form_xpath,$noeud);
    
      # Incrémentation du compteur $following de cette boucle d'éxtraction des formes
      # $following++;
    }
    print MATCHFILE "\n";
  }
  # Fermeture du fichiers de motifs
  close(MATCHFILE);
}

Fiche technique du script :
TRAITEMENT DE LA SURFACE
Premier argument du programme : le fichier cordial
Deuxième argument du programme : le fichier patron
ENTREE : fichiers .cnr contenant les textes étiquetés en BAO2 par Cordial
SORTIE : fichiers textes comprenant les patrons extraits

#!/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 liste....
#-----------------------------------------
my @listedespatrons=();
while (my $lignepos = ) {
    chomp($lignepos);
    push(@listedespatrons,$lignepos);
}
close(FICPOS);
#---------------------------
# Initialisation des listes
#--------------------------
my @malignesegmentee = ();
my @listedetokens = ();
my @listedelemmes = ();
my @listedepos = ();
#-------------------------------------------
# Lecture du fichier de tags ligne par ligne
#-------------------------------------------
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);
#-----------------------------------
# on va maintenant parcourir les POS
# et les TOKENS en //
#----------------------------------------------------------------------------------------
# 1. on cree une liste tmp des POS que l'on va parcourir en supprimant le premier element 
#    a chaque fois
#----------------------------------------------------------------------------------------
my @tmplistedespos=@listedepos;
my $indice=0;
while (my $pos =shift(@tmplistedespos)) {
    foreach my $patron (@listedespatrons) {
  #-----------------------------------
  # on segmente le patron pour connaitre
  # son premier element
  my @listedeterme=split(/\#/,$patron);
  #-----------------------------------
  # on teste si l'element courant POS correspond au premier element du patron...
  if ($pos=~/$listedeterme[0]/) {
      # si c'est OK...
      # on regarde maintenant s'il y a correspondance pour la suite...
      my $verif=0;
      for (my $i=0;$i<=$#listedeterme-1;$i++) {
    if ($tmplistedespos[$i]=~/$listedeterme[$i+1]/) { 
        #Le suivant est bon aussi...
        $verif++ ;
    }
    else {
        # ici : $tmplistedespos[$i] differe de $listedeterme[$i+1]...
    }
      }
      #------------------------------------------------------------------------
      # si verif est egal au nb d'element du patron c'est qu'on a tt reconnu... 
      # on imprime les tokens en // aux POS : astuce $indice permet de garder le 
      # le // entre POS et TOKEN....
      #------------------------------------------------------------------------
      if ($verif == $#listedeterme) { 
    #print "Correspondance sur $patron \n";
    for (my $i=0;$i<=$#listedeterme;$i++) {
        print $listedetokens[$indice+$i]," ";
    }
    print "\n";
      }
  }
    }
    $indice++;
    # on avance dans la liste des POS et des TOKEN en //
}