#  (gH)   -_-  dicopl.pl  ;  TimeStamp (unix) : 24 Juin 2008 vers 16:48

#  test des paramètres

if ($ARGV[0] eq "") { # aide en mode here-doc
     print <<AIDE;
  dico.pl ; création des dictionnaires alphabétiques et fréquentiels d'un texte

  syntaxe : perl dico.pl FICHIER
  exemple : perl dico.pl texte.txt

  les fichiers produits sont dico.tpm et dico.tpo
  dico.tpm : tri par mot croissant
  dico.tpo : tri par fréquence décroissante
             puis par mot croissant an cas d'égalité
AIDE
     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 :" ;
print " on a vu $nbMot mot(s) sur $nbLig ligne(s)" ;
print " et $nbMdi mot(s) différent(s).\n" ;

$dicNom =  "dico.tpm" ;  # fichier alphabétique
$dicOcc =  "dico.tpo" ;  # fichier fréquenciel

open(DICM,">$dicNom ") or die ("impossible d'écrire dans $dicNom") ;
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
  # concaténées avec les mots pour préparer le tri multicritères
  $cle = sprintf("%06d",$cntMot{$m})."_$m" ;
  $tabMot{$cle}=$m ;
} ; # fin pour chaque
close(DICM) ;
print "le fichier $dicNom contient les mots par ordre alphabétique.\n" ;

open(DICK,">$dicOcc ") or die ("impossible d'écrire dans $dicOcc") ;
foreach $c (reverse sort occPuisMot 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 "le fichier $dicOcc contient les mots par ordre décroissant d'occurrences.\n" ;

sub occPuisMot {
   $a =~ /(.*?)_(.*)/ ; ($mota,$occa) = ($2,$1) ;
   $b =~ /(.*?)_(.*)/ ; ($motb,$occb) = ($2,$1) ;
   local($test_num) = $occa <=> $occb ;
   if ($test_num) {return $test_num ;}
   return $motb cmp $mota ;
} # fin du sous-programme de tri multicritères
