Probleme de calcul de Probabilité

**Philou67430** · 15/04/2013, 15h31

En fait, par défaut, si tu ne fournis pas les options -in ou -out, il prends par défaut "Texte_FR.txt" et "Texte_EN.txt".
Il faudrait que j'améliore un peu le script pour (mieux) traiter les cas d'erreur.

**étoile de mer** · 15/04/2013, 17h58

Faut dejà voir pourquoi ca bug chez moi et pas chez toi

**Lolo78** · 15/04/2013, 20h51

D'après ce que dit Philou, parce que tu n'as pas passé les bons paramètres.

**étoile de mer** · 15/04/2013, 21h19

Bonjour lolo
Si si j'ai bien passé ces parametres là :

perl glib.pl -m=2 -n=2 -f=2 1000

Par defaut il va prendre ces param : Texte_FR.txt Texte_EN.txt pour designe les fichier en entrée.
JE ne pense pas que le probleme vient de là

**Philou67430** · 16/04/2013, 08h20

Je n'ai pas trouvé d'explication qu'il puisse venir d'ailleurs que des fichiers d'entrée. Je vais essayer de le relancer de chez moi...

**Philou67430** · 16/04/2013, 08h24

OK, il y a bien un problème. Je corrige et je poste le correctif.

**Philou67430** · 16/04/2013, 08h29

La version corrigée (le bug provenait du fait que la liste des "rules" trouvée pour le filtre et les tailles de combinaison spécifiée pouvait être vide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.10);
 
use Getopt::Long;
 
use File::Util;
use List::Util qw(min sum);
use DB_File;
use Time::ETA;
 
$|++;
 
# taille sequence dans le fichier initiale, du 2e fichier et frequence
my ($n, $m, $f, $size_max) = (1) x 3;
my ($in, $out, $result) = (qw(Texte_FR.txt Texte_EN.txt));
 
GetOptions ('n=i' => \$n, 'm=i' => \$m, 'f=i' => \$f, 'in=s' => \$in, 'out=s' => \$out, 'res=s' => \$result);
 
$size_max = $ARGV[0];
 
$result //= "MMI-m$m-n$n-f$f".($size_max ? "-$size_max" : "").".txt";
 
sub get_x_gram($$) {
  my ($words, $x_gram_size) = @_;
 
  $words = [ split /\s+/, $words ] if !ref $words;
  return map { "@{$words}[$_ .. $_ + $x_gram_size-1]" } 0 .. @$words-$x_gram_size;
}
 
sub trim(\$) {
	my $string = shift;
	$$string =~ s/^\s+|\s+$//;
}
 
my $log2 = log(2);
sub log2($) {
	my $n = shift;
	return log($n)/$log2;
}
 
my $print_progress = 1;
my ($total, $size, $eta, $step, $progress);
sub init_progress {
  my ($universe, $auto_step) = @_;
  $total = (-f $universe ? File::Util->line_count($universe) :
            ref($universe) eq "HASH" ? scalar(keys %$universe) :
            ref($universe) eq "ARRAY" ? scalar(@$universe) : $universe);
  $step = 0;
  $step = min(23, int($total / 20000) || 0) if defined $auto_step && $auto_step == 1;
  $eta = Time::ETA->new(milestones => int($total/($step+1)));
  $progress = 0;
}
sub progress {
  my ($line, $pre, $post) = @_;
  if ($print_progress && $progress++ == $step) {
    $progress = 0;
    $eta->pass_milestone();
 
    return ($pre // "").sprintf "%10d/$total %2d%% (remaining %s, elapsed ".int($eta->get_elapsed_seconds()).") $post",
      $line, $eta->get_completed_percent(), $eta->get_remaining_time();
  }
}
 
init_progress($size_max // $in);
my $line_number = 0;
 
open my $IN,  "<", $in  or die "Can't open $in for reading: $!\n";
open my $OUT, "<", $out or die "Can't open $out for reading: $!\n";
open my $RESULT, ">", $result or die "Can't open $result for writing: $!\n";
 
my ($key_total, $m_gram_total, $n_gram_total) = (0) x 3;
my %key_count;
unlink "key_count_tmp";
my $A = DB_File::HASHINFO->new();
$A->{bsize} = 10000;
$A->{nelem} = $total * 100;
say "nelem=$A->{nelem}";
#tie %key_count, "DB_File", "key_count_tmp", O_RDWR|O_CREAT, 0666, $A if $total > 100000;
keys %key_count = $total * 100 if !tied %key_count;
my (%m_gram_count, %n_gram_count);
say "Starting";
while (defined(my $words1 = <$IN>)) {
  print progress(++$line_number, "Counting rules ", scalar(keys %key_count)."      \r");
  trim($words1);
  my $words2 = <$OUT>;
  trim($words2);
 
  my @words1 = split /\s+/, $words1;
  my @m_gram = get_x_gram(\@words1, $m);
  my %line_m_gram_count;
  $line_m_gram_count{$_}++ foreach @m_gram;
  $m_gram_count{$_} += $line_m_gram_count{$_} foreach keys %line_m_gram_count;
  # Filter m_gram with frequence > $f
  if (grep $line_m_gram_count{$_} > $f, keys %line_m_gram_count) {
    my @words2 = split /\s+/, $words2;
    my @n_gram = get_x_gram(\@words2, $n);
 
    foreach my $m_gram (@m_gram) {
      foreach my $n_gram (@n_gram) {
        $key_count{$m_gram}->{$n_gram}++;
      }
    }
    my %line_n_gram_count;
    $line_n_gram_count{$_}++ foreach @n_gram;
    $n_gram_count{$_} += $line_n_gram_count{$_} foreach keys %line_n_gram_count;
    $key_total += @m_gram * @n_gram;
    $m_gram_total += @m_gram;
    $n_gram_total += @n_gram;
  }
 
  last if $size_max && $line_number >= $size_max;
}
 
say "";
say "Counting total rules";
my ($total_rules, $rule) = (sum(map scalar(keys %{$_}), values %key_count) // 0, 0);
if ($total_rules) {
  init_progress($total_rules, 1);
  foreach my $m_gram (sort keys %key_count) {
    foreach my $n_gram (sort keys %{$key_count{$m_gram}}) {
      my $mmi = $key_count{$m_gram}->{$n_gram};
 
      $mmi /= $key_total;
      $mmi *= log2($mmi/($m_gram_count{$m_gram}/$m_gram_total)*($n_gram_count{$n_gram}/$n_gram_total));
 
      print progress($rule++, "Computing MMI ", "      \r");
      printf { $RESULT } "$m_gram > $n_gram > %.10f\n", $mmi;
    }
  }
}
else {
  say "No rule found for the specified filter";
  say { $RESULT } "No rule found for the specified filter";
}

**étoile de mer** · 16/04/2013, 10h25

Bonjour Philou
Merci pour le correctif.
Je viens là de tester sur un ti corpus de 2 ligne

perl glib.pl -m=2 -n=2

et j'ai pas fait de filtrage

et il n'a rien affiché comme resultat :

No rule found for the specified filter

Bizarre non ?

**Philou67430** · 16/04/2013, 12h08

Non, c'est normal, le filtre par défaut est 1, et sur 2 lignes seulement, il peut n'y avoir aucune combinaison de 1 mot en double (aucun mot en double).
Pour limiter la taille du corpus, par exemple à 100 lignes, tu peux le spécifier dans la ligne de commande, en ajoutant le nombre de ligne à analyser :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

perl glib.pl -m=2 -n=2 100

A demain

**étoile de mer** · 17/04/2013, 09h01

Bonjour
J'ai testé ce script sur deux fichier contenant deux ligne chacun :

Fichier1

Bonjour les amis
Bonjour les amis du monde

Fichier2:

Good morning my friends
Good morning my friends of the world

D'apres les resultat je vois bien qu'Il ya deux probleme :

Prob1:
Quand j'ai lancé le script avec cette commande :

perl glib.pl -m=3-n=3 -f 1

Il n'a rien affiché

No rule found for the specified filter

Je ne vois pas pourquoi car il doit afficher les regles commencant par "Bonjour les amis" ->...
car "Bonjour les amis" appartient 2 fois dans le corpus du coup elle ne doit pas etre supprimé par le filtre.

Pro2:
Deuxième probleme c'est que quand j'ai lance le scripte avec cette commande

perl glib.pl -m=3-n=3 -f 0

J'ai trouvé des resultat mais avec des valeur fausses (apres verifications du calcul à la main)

Par exemple il a affiché :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Bonjour les amis -> Good morning my > -0.4582

Normallement elle doit etre égale =
p(bonjour les amis, good morning my)*log(p(bonjour les amis, good morning my))/(p(bonjour les amis)P(good morning my)))

(2/(4*7)) log ((2/(4*7))/ ((2/4)*(2/7))) = -0.071

MErci

**Philou67430** · 17/04/2013, 09h37

OK, j'attendais que tu puisses tester. Je vais essayer de regarder ce matin, faut que je me replonge dans le programme, c'est déjà presque vieux

Je suppose que ton chef attend le résultat pour le mois dernier ?

**étoile de mer** · 17/04/2013, 09h41

Il m'a dit ce matin : " alors o on est avec le bébé" faut attendre 9 mois ?

Je peux t'aider si tu veux

**Philou67430** · 17/04/2013, 11h16

Je sors à peine de réunion. Je vais essayer le script avec ton exemple... en pas à pas.

**étoile de mer** · 17/04/2013, 11h19

Merci beaucoup

On peut traiter probleme par probleme

**Philou67430** · 17/04/2013, 12h04

Premier bug à corriger, le filtrage :
remplacer la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  if (grep $line_m_gram_count{$_} > $f, keys %line_m_gram_count) {

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  if (grep $line_m_gram_count{$_} >= $f, keys %line_m_gram_count) {

(l'opérateur > strict n'est pas approprié ici).

**Philou67430** · 17/04/2013, 12h07

Pourrais-tu me confirmer avec les paramètres suivant :
perl glib.pl -m=2 -n=2

je dois avoir 24 rules au total ?

**Philou67430** · 17/04/2013, 12h34

Deuxième bug : le nombre total de combinaisons, qui vient d'une incompréhension que j'avais évoquée ici (et à laquelle je n'avais pas eu de réponse, il me semble

).
En fait, je calculais ce total en sommant pour chaque ligne le produit du nombre de m_gram et du nombre de n_gram, alors qu'il faut semble-t-il le calculer par le produit du nombre total de m_gram sur toutes les lignes du 1er fichier et du nombre total de n_gram sur toutes les lignes du 2e fichier.

Il faut donc corriger en commentant la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    #$key_total += @m_gram * @n_gram;

et en ajoutant la ligne suivante après la première boucle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    $m_gram_total += @m_gram;
    $n_gram_total += @n_gram;
  }
 
  last if $size_max && $line_number >= $size_max;
}
$key_total = $m_gram_total * $n_gram_total;

(il s'agit de la dernière ligne).

Je continue d'investiguer après manger.

**Philou67430** · 17/04/2013, 14h20

Envoyé par étoile de mer

(2/(4*7)) log ((2/(4*7))/ ((2/4)*(2/7))) = -0.071

Avec le programme que j'ai actuellement, je peux afficher le calcul formel (tel que tu l'écris ici) pour le vérifier (option -d).
Le résultat, pour l'exemple donné est correct après une troisième correction de bug. Je te livre le nouveau script en entier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
#!/usr/bin/perl
 
use strict;
use warnings;
use feature qw(:5.10);
 
use Getopt::Long;
 
use File::Util;
use List::Util qw(min sum);
use Time::ETA;
 
$|++;
 
# taille sequence dans le fichier initiale, du 2e fichier et frequence
my ($n, $m, $f, $size_max, $debug) = (1) x 3;
my ($in, $out, $result) = (qw(Texte_FR.txt Texte_EN.txt));
 
GetOptions ('n=i' => \$n, 'm=i' => \$m, 'f=i' => \$f, 'in=s' => \$in, 'out=s' => \$out, 'res=s' => \$result, 'd' => \$debug);
 
$size_max = $ARGV[0];
 
$result //= "MMI-m$m-n$n-f$f".($size_max ? "-$size_max" : "").".txt";
 
sub get_x_gram($$) {
  my ($words, $x_gram_size) = @_;
 
  $words = [ split /\s+/, $words ] if !ref $words;
  return map { "@{$words}[$_ .. $_ + $x_gram_size-1]" } 0 .. @$words-$x_gram_size;
}
 
sub trim(\$) {
	my $string = shift;
	$$string =~ s/^\s+|\s+$//;
}
 
my $log2 = log(2);
sub log2($) {
	my $n = shift;
	return log($n)/$log2;
}
 
my $print_progress = 1;
my ($total, $size, $eta, $step, $progress);
sub init_progress {
  my ($universe, $auto_step) = @_;
  $total = (-f $universe ? File::Util->line_count($universe) :
            ref($universe) eq "HASH" ? scalar(keys %$universe) :
            ref($universe) eq "ARRAY" ? scalar(@$universe) : $universe);
  $step = 0;
  $step = min(23, int($total / 20000) || 0) if defined $auto_step && $auto_step == 1;
  $eta = Time::ETA->new(milestones => int($total/($step+1)));
  $progress = 0;
}
sub progress {
  my ($line, $pre, $post) = @_;
  if ($print_progress && $progress++ == $step) {
    $progress = 0;
    $eta->pass_milestone();
 
    return ($pre // "").sprintf "%10d/$total %2d%% (remaining %s, elapsed ".int($eta->get_elapsed_seconds()).") $post",
      $line, $eta->get_completed_percent(), $eta->get_remaining_time();
  }
}
 
init_progress($size_max // $in);
my $line_number = 0;
 
open my $IN,  "<", $in  or die "Can't open $in for reading: $!\n";
open my $OUT, "<", $out or die "Can't open $out for reading: $!\n";
open my $RESULT, ">", $result or die "Can't open $result for writing: $!\n";
 
my ($key_total, $m_gram_total, $n_gram_total) = (0) x 3;
my %key_count;
unlink "key_count_tmp";
keys %key_count = $total * 100 if !tied %key_count;
my (%m_gram_count, %n_gram_count);
say "Starting";
while (defined(my $words1 = <$IN>)) {
  print progress(++$line_number, "Counting rules ", scalar(keys %key_count)."      \r");
  trim($words1);
  my $words2 = <$OUT>;
  trim($words2);
 
  my @words1 = split /\s+/, $words1;
  my @m_gram = get_x_gram(\@words1, $m);
  my %line_m_gram_count;
  $line_m_gram_count{$_}++ foreach @m_gram;
  $m_gram_count{$_} += $line_m_gram_count{$_} foreach keys %line_m_gram_count;
  # Filter m_gram with frequence >= $f
  if (grep $line_m_gram_count{$_} >= $f, keys %line_m_gram_count) {
    my @words2 = split /\s+/, $words2;
    my @n_gram = get_x_gram(\@words2, $n);
 
    foreach my $m_gram (@m_gram) {
      foreach my $n_gram (@n_gram) {
        $key_count{$m_gram}->{$n_gram}++;
      }
    }
    my %line_n_gram_count;
    $line_n_gram_count{$_}++ foreach @n_gram;
    $n_gram_count{$_} += $line_n_gram_count{$_} foreach keys %line_n_gram_count;
    #$key_total += @m_gram * @n_gram;
    $m_gram_total += @m_gram;
    $n_gram_total += @n_gram;
  }
 
  last if $size_max && $line_number >= $size_max;
}
$key_total = $m_gram_total * $n_gram_total;
 
say "";
say "Counting total rules";
my ($total_rules, $rule) = (sum(map scalar(keys %{$_}), values %key_count) // 0, 0);
if ($total_rules) {
  say "total key: $key_total or ", $m_gram_total * $n_gram_total;
  init_progress($total_rules, 1);
  foreach my $m_gram (sort keys %key_count) {
    foreach my $n_gram (sort keys %{$key_count{$m_gram}}) {
      my $mmi = $key_count{$m_gram}->{$n_gram};
 
      my $mmi_str = qq{(\$key_count{$m_gram}->{$n_gram}} if $debug;
      my $mmi_num = qq{($mmi} if $debug;
 
      $mmi /= $key_total;
      if ($debug) {
        $mmi_str .= qq{ / \$key_total)};
        $mmi_num .= qq{ / $key_total)};
      }
      if ($debug) {
        $mmi_str .= qq{ * log2(\$mmi / (\$m_gram_count{$m_gram}/\$m_gram_total)*(\$n_gram_count{$n_gram}/\$n_gram_total))};
        $mmi_num .= qq{ * log2($mmi / ($m_gram_count{$m_gram}/$m_gram_total)*($n_gram_count{$n_gram}/$n_gram_total))};
        say { $RESULT } "$m_gram > $n_gram > ", $mmi_str;
        say { $RESULT } "$m_gram > $n_gram > ", $mmi_num;
      }
      $mmi *= log2($mmi/(($m_gram_count{$m_gram}/$m_gram_total)*($n_gram_count{$n_gram}/$n_gram_total)));
 
      print progress($rule++, "Computing MMI ", "      \r");
      printf { $RESULT } "$m_gram > $n_gram > %.10f\n", $mmi;
    }
  }
}
else {
  say "No rule found for the specified filter";
  say { $RESULT } "No rule found for the specified filter";
}