Solutions des exercices du tuteur Perl (gH)

   Téléchargez l'archive des programmes perl présentés.

Solution de l'exercice "numérotation des lignes d'un fichier"

Si l'énoncé n'avait pas demandé que les numéros de ligne soient biens cadrés, on aurait pu, sous Unix, se contenter d'utiliser la commande grep -n "" nom_fichier.

Une solution classique vérifie l'existence du paramètre, l'ouverture possible du fichier avant de nommer $lig la ligne vue dans le fichier avec une variable explicite nommée $numero qu'on incrémente dans la boucle de lecture, soit le programme : 

   #  test des paramètres

   if ($ARGV[0] eq "") {
        print " syntaxe : perl numerote.pl nom_de_fichier \n" ;
        exit(-1) ;
   }  ; # fin de test sur les arguments

   $fichier = $ARGV[0] ; # récupération du nom du fichier

   # ouverture du fichier

   open( FIC ,"<$fichier")
     || die "\n impossible d'ouvrir le fichier nommé $fichier \n\n" ;

   # affichage numéroté

   $numero = 0 ;
   while ($lig=<FIC>) {
     $numero++ ;
     print sprintf("  %04d  ",$numero).$lig ;
   } ; # fin de tant que

Une écriture plus "perlienne" vient utiliser les variables spéciales aux noms barbares à savoir $. et $_ :


   die(" syntaxe : perl numerote.pl nom_de_fichier \n ")
      if ($ARGV[0] eq "") ;

   open( FIC ,"<$ARGV[0]")
      or die "\n impossible d'ouvrir le fichier nommé $ARGV[0] \n\n" ;

   while (<FIC>) { print sprintf("  %04d  ",$.).$_ ; } ;

Solution de l'exercice "variables d'environnement"

Une solution classique consiste à stocker dans un fichier-texte le résultat de la commande set puis à parcourir les lignes et à les découper (le séparateur est le symbole "égale"), soit le programme :

     print "\n Variable           Valeur\n\n" ;

     $ficenv = "set.tmp" ;

     # sauvegarde dans un fichier

     `set > $ficenv ` ;

     # parcours du fichier

     open(FENV,"<$ficenv") or die ("impossible d'ouvrir $ficenv") ;
     $nbve = 0 ;
     while ($ligne=<FENV>) {
       $nbve++ ;
       chop($ligne) ;
       @ligenv = split(/=/,$ligne) ;
       ($tvar[$nbve],$tval[$nbve]) = @ligenv ;
     } ; # fin de tant que

     # affichage

     for ($idve=1;$idve<=$nbve;$idve++) {
           print  sprintf(" %-20s",$tvar[$idve])
                 .sprintf("%-40s",$tval[$idve])."\n" ;
     } ; # fin de pour chaque
Remarque : au lieu de 
       @ligenv = split(/=/,$ligne) ;
       ($tvar[$nbve],$tval[$nbve]) = @ligenv ;
on aurait pu écrire : 

       ($tvar[$nbve],$tval[$nbve]) = split(/=/,$ligne) ;

Une solution plus "perliste" consiste à savoir que la table de hachage nommée %ENV contient les variables d'environnement et leurs valeurs. On remarquera qu'on trie au passage (ce qui n'est sans doute pas nécessaire) les clés sans utiliser keys car Perl s'en doute !

     print "\n Variable           Valeur\n\n" ;

     foreach $ve (sort %ENV) {
       if (defined $ENV{$ve}) {
           print  sprintf(" %-20s",$ve)
                 .sprintf("%-40s",$ENV{$ve})."\n" ;
       } ; # fin de si variable définie
     } ; # fin de pour chaque

 
Pour l'affichage en cgi avec de la couleur, nous renvoyons le lecteur au code-source de la page http://www.info.univ-angers.fr/scripts/env.pl
 

Solution de l'exercice "dictionnaires d'un fichier-texte"

Nous laissons (comme nouvel exercice) le soin au lecteur de détailler les instructions Perl utilisées. A part =~, tr et s/ toutes ces instructions ont déja été vues

...

 

     #  test des paramètres

     if ($ARGV[0] eq "") {
          print " syntaxe : perl dicos.pl nom_de_fichier \n" ;
          exit(-1) ;
     }  ; # fin de test sur les arguments

     $fictxt = $ARGV[0] ; # récupération du nom du fichier

     # ouverture du fichier

     open( FICT ,"<$fictxt") 
       || die "\n impossible d'ouvrir le fichier nommé $fictxt \n\n" ;

     # parcours du fichier, remplissage du hachage au passage

     $nbLig = 0 ; # nombre de lignes du fichier
     $nbMot = 0 ; # nombre de mots en tout
     $nbMdi = 0 ; # nombre de mots différents

     while ($ligne=<FICT>) {
       $nbLig++ ;
       chop($ligne) ;
       # on élimine la ponctuation
       $ligne  =~  tr/,.:!'"();/         / ;
       # on élimine le double tiret
       $ligne  =~  s/--//g ;
       @mots = split(/ /,$ligne) ;
       foreach $m (@mots) {
         if (length($m)>0) {
           $nbMot++;
           $cntMot{$m}++ ;
           if ($cntMot{$m}==1) {
               $nbMdi++ ;
           } ; # finsi nouveau mot
         } ; # finsi mot non vide
       } ; # fin pour chaque mot
     } ; # fin de tant que

     print " Analyse du fichier $fictxt :\n" ;
     print "    $nbLig ligne(s), $nbMot mot(s) 
                    dont $nbMdi mot(s) différent(s).\n" ;

     $dicNom =  "dic_$fictxt.mot" ;  # fichier alphabétique
     $dicOcc =  "dic_$fictxt.occ" ;  # fichier fréquenciel

     open(DICM,">$dicNom ") 
        or die ("impossible d'écrire dans $dicNom") ;
     print DICM  "fichier $dicNom issu de $0 $fictxt\n" ;
     foreach $m (sort keys(%cntMot)) {
       print DICM  sprintf("   %-20s",$m)
                  .sprintf("%4d",$cntMot{$m})."\n" ;
       # on en profite pour remplir un tableau pour les occurences
       $cle = sprintf("%04d",$cntMot{$m})."_$m" ;
       $tabMot{$cle}=$m ;
     } ; # fin pour chaque
     close(DICM) ;

     open(DICK,">$dicOcc ") 
        or die ("impossible d'écrire dans $dicOcc") ;
     print DICK  "fichier $dicOcc issu de $0 $fictxt\n" ;
     foreach $c (reverse sort keys(%tabMot)) {
       # on sait comment Perl convertit les %s en %c, on en profite :
       print DICK  sprintf("   %-20s",$tabMot{$c})
                  .sprintf("%4d",$c)."\n" ;
     } ; # fin pour chaque
     close(DICK) ;

     print " Vous pouvez consulter les fichiers  $dicNom et $dicOcc \n" ;
     print " dont voici le début : \n\n" ;
     system("head -n 20 $dicNom") ;
     system("head $dicOcc") ;

 

Solution de l'exercice "calcul de Chi2"

Installer un module consiste à recopier le fichier-texte correspondant dans "le bon répertoire". Lorsqu'on est root, ceci peut se faire en ligne de commande. Si on dispose des droits suffisants, pour notre exemple, on écrit seulement 

     perl -MCPAN -e 'install Statistics::Distributions'
L'utilisateur courant peut alors se contenter d'écrire
     use Statistics::Distributions ;
     $df = 17  ;
     $pr = 0.05 ;
     $vc = Statistics::Distributions::chisqrdistr ($df,$pr);
     print "  valeur de chi2 : $vc \n" ;
Si par contre on de dispose pas des droits root, il est possible de copier le fichier localement et de l'indiquer à perl. Par exemple si on crée le répertoire /home/info/gh/Bin/Perl_lib/, si on y crée ensuite le répertoire /home/info/gh/Bin//Perl_lib/Statistics et si on met le fichier Distributions.pm dans ce répertoire Statistics alors il suffit d'ajouter au début du programme perl précédent la ligne 
     use lib "/home/info/gh/Bin/Perl_lib" ;
pour que perl aille chercher ce qu'il lui manque comme module à l'endroit indiqué.

Solution de l'exercice "fichiers DBF"

Le format Dbase et plus généralement le format Xbase sont des formats qui permettent de stocker "proprement" des tableaux rectangulaires de données. Sans être des fichiers de base de données lourdes comme Oracle ou Sql, ces fichiers sont lisibles par la plupart des logiciels comme Excel ou les autres tableurs courant. Leur grand intérêt est d'utiliser comme unité de base de structure les colonnes (ou "champs"). Ils garantissent donc la constance du nombre de champs sur l'ensemble des lignes et l'homogénéité des données à l'intérieur d'une même colonne. De plus ils sont très économiques en terme de stockage car après la définition des colonnes on trouve les données bout à bout sans caractère de controle. Ainsi pour 18 lignes de 59 caractères soit 1062 octets, le fichier DBF fait 1384 octets (soit moins de 2 kO) alors que le même fichier lu sous Excel 10 et enregistré au format XLS fait 14 384 octets soit plus de 14 kO c'est à dire 10 fois plus !. Après avoir lu la page de man de XBASE disponible ici il est relativement simple d'écrire le programme dbase.pl suivant : 

 
 
     use lib "/home/gh/Bin";
     use XBase ; 
 
     $nomBase = "vins.dbf" ; 
     $table = new XBase $nomBase or die XBase->errstr; 
     $nbr = $table->last_record ; 
 
     print " il y a  ".(1+$nbr)." enregistrements dans la base $nomBase ;
     for (0 .. $nbr) { 
         print sprintf("%5d. ",1+$_) ; 
         @enrc = $table->get_record($_) ; 
         $ndc = -1 ; 
         foreach $ch (@enrc) { 
            $ndc++ ; 
            if ($ndc>0) { print "$ch" ; }
         } ; # fin pour chaque champ 
         print "\n \n" ;
     } ; # fin pour enregistrement
Si on l'applique au fichier vins.dbf proposé, on voit alors : 
 
  il y a  18 enregistrements dans la base vins.dbf                
     1. CHMP 7069 3786 12578 8037 13556 9664 10386 206            
     2. MOS1 2436 586 2006 30 1217 471 997 51                     
     3. MOS2 3066 290 10439 1413 7214 112 3788 330                
     4. ALSA 2422 1999 17183 57 1127 600 408 241                  
     5. GIRO 22986 22183 21023 56 30025 6544 13114 3447           
     6. BOJO 17465 19840 72977 2364 39919 17327 17487 2346        
     7. BORG 3784 2339 4828 98 7885 3191 11791 1188               
     8. RHON 7950 10537 7552 24 8172 11691 1369 1798              
     9. ANJO 2587 600 2101 0 7582 143 872 131                     
    10. AOCX 17200 22806 15979 50 20004 1279 4016 944             
    11. VDQS 1976 1029 1346 0 2258 212 1017 487                   
    12. XXXX 38747 19151 191140 7992 101108 1029 26192 38503      
    13. PROV 1375 1150 2514 0 284 401 9 236                       
    14. MUSC 2016 2908 1529 0 12891 18 716 653                    
    15. RHOF 785 1648 1009 6 775 643 542 35                       
    16. AOCF 160 246 135 8 1177 26 7 0                            
    17. XXXF 24 1533 160 0 480 0 0 0                              
    18. XXFF 2415 74 208 8 1705 12 36 47
En, rajoutant les instructions de tableau TR, TD etc. (voir le programme dbaset.pl) on obtient alors le joli affichage de la page dbaset.htm

Solution de l'exercice "extractions d'adresses"

Lorsqu'on met .* perl cherche à satisfaire l'expression régulière en mode gourmand sans garder une trace de ce qui correspond. Mettre ? permet de satisfaire l'expression régulière en mode modéré et utiliser les parenthèses met en mémoire ce qui correspond dans les variables $1, $2 etc.

Ici, on veut dans une ligne comme <a href="www.google.fr">google</a> récupérer les champs entre <a href=" et le guillemet suivant et récupérer aussi ce qu'il y a entre le > et </a> ; comme on veut pas récupérer ce qu'il y a entre les deux (comme par exemple target="_blank" ) on ne met pas de parenthèses.

Si on met +=1 l'affectation est faite après l'affichage après et on ne voit que les références utilisées aumoins 2 fois, soit : 

 
 
  Homo sapiens                   http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Homo+sapiens 
  Mus musculus                   http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Mus+musculus 
  Sus scrofa                     http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Sus+scrofa 
  Pseudomonas aeruginosa         http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Pseudomonas+aeruginosa 
  Escherichia coli               http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Escherichia+coli 
  Bos taurus                     http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Bos+taurus 
  Bacillus stearothermophilus    http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Bacillus+stearothermophilus 
  Spinacia oleracea              http://www.ncbi.nlm.nih.gov/Taxonomy/Browser/wwwtax.cgi?name=Spinacia+oleracea

Pour trier les affichages, on peut écrire

 
     while (m|<a href=\"(.*?)\".*?>(.*?)</a>>|gs) { 
       $nom{$2}++ ; 
       if ($nom{$2}==1) {  $sites{$2} = $1 ; } ; 
     } ; # fin tant que 

     foreach $lien (sort keys %sites) { 
         print "  ".sprintf("%-30s %-30s",$lien, $sites{$lien}); 
     } ; # fin pour chaque

Retour au tuteur Perl (gH)

 

retour gH    Retour à la page principale de   (gH)