Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1386 connectés 

  FORUM HardWare.fr
  Programmation
  Perl

  optimisation script perl

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

optimisation script perl

n°2301038
mouda
Posté le 22-05-2017 à 11:24:20  profilanswer
 

Bonjour à tous,
Le script suivant permet le calcul de l'IDF d'un mot (pour un mot w, idf(w) = log(nombre des phrases dans mon corpus / nombre des phrases contenant le mot w)  
 
d'après les tests que je l'ai fait, ce script marche bien  , cependant il est long , comment je peux l'optimiser.
voici le code

Code :
  1. #calcul le IDF d'un mot
  2.  
  3.    use strict;
  4.    use warnings;
  5.    use autodie;
  6.  
  7.  
  8. my $nbre_ligne = 4159480;
  9.  
  10.  
  11.  
  12. open my $fh_resultat, ">:utf8", '/home/lenovo/Bureau/MesTravaux/IDF/out';
  13. use constant CORPUS_MOT => '/home/lenovo/Bureau/MesTravaux/IDF/test';
  14. use constant CORPUS_Phrases => '/home/lenovo/Bureau/MesTravaux/IDF/phrases';
  15.  
  16. my @tab_MOT_CORPUS = do {
  17.    open my $fh1, "<:utf8", CORPUS_MOT;
  18.    map { split } <$fh1>;
  19.  
  20. };
  21.  
  22. open my $fh2, "<:utf8", CORPUS_Phrases;
  23.  
  24. my @tab_phrase_CORPUS = <$fh2>;
  25.  
  26. my $size = 0;
  27. chomp @tab_phrase_CORPUS;
  28. foreach my $mot (@tab_MOT_CORPUS) {
  29. my $nb_phrase = 0;
  30. my $log;
  31. my $idf;
  32. foreach my $ph (@tab_phrase_CORPUS) {
  33. my @tab = split(/ /, $ph);
  34. chomp @tab ;
  35. $size = $#tab;
  36. foreach my $val(@tab) {
  37. if($mot eq $val)
  38. {
  39. $nb_phrase = $nb_phrase + 1;
  40. last;
  41. }
  42. }
  43. }
  44. #calcul log
  45. if($nb_phrase == 0) {$idf =0;}
  46. else
  47. {
  48. $idf = (log($nbre_ligne/$nb_phrase))/log(10);}
  49. print $fh_resultat "$mot:$nb_phrase:$idf\n";
  50. }

mood
Publicité
Posté le 22-05-2017 à 11:24:20  profilanswer
 

n°2301068
gilou
Modérateur
Modzilla
Posté le 22-05-2017 à 19:33:38  profilanswer
 

my $nbre_ligne = 4159480;
non!
my @tab_phrase_CORPUS = <$fh2>;
my $nbre_ligne = scalar(@tab_phrase_CORPUS);
 
Ensuite:
foreach my $mot (@tab_MOT_CORPUS) {
...
foreach my $ph (@tab_phrase_CORPUS) {
 
surtout pas! ca fait parcourir ton gros fichier scalar(@tab_MOT_CORPUS) fois.
 
 
Il ne faut parcourir @tab_phrase_CORPUS qu'une seule fois.
et passer par un hash pour accumuler les valeurs
Bref faire un truc dans ce gout la (pas testé):
 
use List::Util qw(uniqstr);
use Array::Utils qw(intersect);
 
my %tab_MOT_CORPUS;
{
    open my $fh1, "<:utf8", CORPUS_MOT;
    while (<$fh1> ) {
        chop;
        foreach (split) {
            $tab_MOT_CORPUS{$_}=0;
        }
    }
}
# on a créé un hash de clés les mots du corpus et de valeurs 0
 
my @mots_corpus = keys %tab_MOT_CORPUS;
my $nbre_ligne = 0;
foreach (@tab_phrase_CORPUS) {
    $nbre_ligne++;
    chop;
    my @mots = split;
    @mots = uniqstr (@mots);
    @mots = intersect(@mots_corpus, @mots);
    # mots contient la liste des mots de la phrase qui sont dans le corpus, chacun étant distinct
    foreach (@mots) {
        $tab_MOT_CORPUS{$_}++;
        # pour chacun, on incrémente le nb de lignes ou il figure
    }
}
 
Note:
Je me demande si un truc plus basique serait pas plus efficace en fait:
my %lignes;
my $nbre_phrases = 0;
{
    open my $fh, "<:utf8", CORPUS_MOT;
    while (<$fh1> ) {
        $nbre_phrases++;
        chop;
        my @mots = split;
        foreach (uniqstr(@mots)) {
            $lignes{$_}++;
        }
    }
    close $fh;
}
 
et ensuite
sub idf($) {
    my $mot= shift;
    if ($nbre_phrase and $lignes{$mot}) {
        return log($lignes{$mot}/$nb_phrase)/log(10);
    }
    else {
        return 0;
    }
}
 
Bref on construit un hash global pour tous les mots de ton corpus de texte, plutôt que de perdre du temps a chaque ligne a le filtrer vis a vis de ton corpus de mots. Ça ira plus vite, mais ça bouffera un peu plus de mémoire (mais pas plus que ton my @tab_phrase_CORPUS = <$fh2>; a priori).
 
A+,


Message édité par gilou le 22-05-2017 à 22:21:26

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2301071
mouda
Posté le 23-05-2017 à 00:12:02  profilanswer
 

bonsoir gilou, merci beaucoup pour la réponse
j'ai testé avec la première version, mais j'ai eu en sortie : "uniqstr" is not exported by the List::Util module
 
j'ai cherché sur google, mais j'ai pas réussi à trouver une solution ..

n°2301086
gilou
Modérateur
Modzilla
Posté le 23-05-2017 à 10:41:13  profilanswer
 

Probablement parce que votre module List::Util n'est pas à jour.
Si je regarde sur CPAN, c'est dedans:
http://search.cpan.org/~pevans/Sca [...] st/Util.pm

Code :
  1. use List::Util qw(
  2.      reduce any all none notall first
  3.  
  4.      max maxstr min minstr product sum sum0
  5.  
  6.      pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap
  7.  
  8.      shuffle uniq uniqnum uniqstr
  9.    );


uniqstr fait partie des fonctions exportées.
 
A+,


Message édité par gilou le 23-05-2017 à 10:41:30

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2301139
gilou
Modérateur
Modzilla
Posté le 25-05-2017 à 14:04:21  profilanswer
 

Bon, j'ai eu le temps de regarder cela d'un peu plus près, vu que je bosse pas aujourd'hui.
Suite a vos mails en MP, je ferais ainsi:

Code :
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use autodie;
  5.  
  6. # Pour virer la BOM utf8 (inutile mais hélas mise par MS-Windows, et qui s'incruste au premier mot du corpus).
  7. use File::BOM qw(open_bom);
  8.  
  9. sub build_corpus($) {
  10.    open_bom my $fh, shift;
  11.    my %corpus;
  12.    while (<$fh> ) {
  13.         chomp;
  14.         next if (/^\s*$/);
  15.         $corpus{$_} = {};
  16.    }
  17.    close $fh;
  18.    return \%corpus;
  19. }
  20.  
  21. sub parse_data($$) {
  22.    my $corpus = shift;
  23.    open_bom my $fh, shift;
  24.    my $linenum;
  25.    while (<$fh> ) {
  26.         chomp;
  27.         next if (/^\s*$/);
  28.         ++$linenum; # ou le mettre avant le chomp si on ne veut aussi compter les lignes vides
  29.         foreach (split /\b/) {
  30.             next if (/\s+/);
  31.             if ($corpus->{$_}) {
  32.                 $corpus->{$_}{$linenum}++;
  33.             }
  34.         }
  35.    }
  36.    close $fh;
  37.    return $linenum;
  38. }
  39.  
  40. sub idf($$$) {
  41.    my ($corpus, $nblignes, $mot) = (shift, shift, shift);
  42.    if ($corpus->{$mot}) {
  43.         my $matchlines = scalar(keys %{$corpus->{$mot}});
  44.         if ($matchlines) {
  45.             return log($matchlines/$nblignes)/log(10);
  46.         }
  47.         else {
  48.             # ou ce que vous voulez pour un mot du corpus sans occurence dans les données
  49.             return 0;
  50.         }
  51.    }
  52.    else {
  53.         # mot pas dans le corpus
  54.         return 0;
  55.    }
  56. }
  57.  
  58. sub save_result($$$) {
  59.    my ($corpus, $nblignes) = (shift, shift);
  60.    open my $fh, '>:utf8', shift;
  61.    foreach (sort(keys %{$corpus})) {
  62.         print $fh $_, " : ", idf($corpus, $nblignes, $_), "\n";
  63.    }
  64.    close $fh;
  65. }
  66.  
  67. ###############
  68. # les données #
  69. ###############
  70. my $corpus_file = "file1.txt";
  71. my $data_file = "file2.txt";
  72. my $result_file = "file3.txt";
  73.  
  74. #################
  75. # le traitement #
  76. #################
  77. print "Lecture du corpus...";
  78. my $corpus = build_corpus($corpus_file);
  79. print "OK. ", scalar(keys %{$corpus}), " mots lus\n";
  80.  
  81. print "Lecture des lignes...";
  82. my $nblignes = parse_data($corpus, $data_file);
  83. print "OK. ", $nblignes, " lignes lues\n";
  84.  
  85. print "Ecriture des resultats...";
  86. save_result($corpus, $nblignes, $result_file);
  87. print "OK.\n";


 
Vu la taille de votre corpus, 1M de mots et 4M de lignes, c'est ce que je pense être le plus efficace.
Le seul endroit ou ca risque de ne pas satisfaire vos besoins, c'est le split /\b/.
En effet, si vos données sont en unicode, il n'est pas certain que cela ne splitte pas sur tout caractère accentué ou inhabituel.
Auquel cas, il faudra remplacer le /\b/ par une expression régulière plus adaptée (\b{wb}\ ?).
En tout cas, j'ai testé vite fait avec un mot comme Sørensen ou حاطه et il y avait pas de pb avec \b
Pour les perfs, on lit chaque ligne une seule fois, donc ça devrait rester acceptable.
 
Bon par contre si on a du bidirectionnel, faudra faire évoluer ce code, sinon on aura des choses style:  
حاطه : -0.477121254719662  :D
 
A+,


Message édité par gilou le 25-05-2017 à 21:33:19

---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Perl

  optimisation script perl

 

Sujets relatifs
Cliquer sur un bouton d'une boite de dialogue via un scriptScript pour désinstaller le pack office
[PHP] droits du user du script ?script perl pour remplacement des chiffre en mots
[PERL/MySQL] Utilisation d'une variable dans la clause WhereExplication d'un script C
.jar avec perlProblème script javascript
supprimer retour à la ligne 
Plus de sujets relatifs à : optimisation script perl


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR