Discussion :

[stoyak]

Bonjour,

Je souhaiterais une explication sur la notion de retour arrière dans les expressions régulières perl.
Voici un exemple :
Soit une chaine du type suivant : CATCCTCCTTAAGC
Je cherche à calculer le nombre de motifs suivant :
- CAA
- CAT
- CAC
- CTA
- CTT
- CTC
- CCA
- CCT
- CCC
Je recherche ces 9 motifs.
Si je fais 9 expressions régulières + la somme de chaque résultat, j'ai le bon résultat. Si je cherche à faire une seule expression régulière, j'obtiens un résultat différent à cause du chevauchement des motifs et du non retour en arrière de l'expression régulière en cas de succès de matching. Comment faire une expression régulière récursive, optimale sans qu'elle ne tourne à l'infinie.

Voici mon programme et résultat.

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
#!/usr/bin/perl
 
use strict;
use Carp;
use warnings;
 
my $sequence = 'CATCCTCCTTAAGC';
my $somme = 0;
my @motifs = qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
 
foreach my $motif ( @motifs ) {
  my @match = $sequence =~ m{$motif}g;
  my $nbr = scalar @match;
  $somme += $nbr;
  print "Motif : $motif ($nbr)\n"; 
  print "Match : @match\n"; 
}
print "Somme : $somme\n\n";
 
my @match2 = $sequence =~ m{C[ATC][ATC]}g;
my $somme2 = scalar @match2;
print "Regex : m{C[ATC][ATC]}g\n";
print "Match2 : @match2\n"; 
print "Somme2 : $somme2\n\n";
 
my $regex_join = join('|', @motifs);
my @match3 = $sequence =~ m{$regex_join}g;
my $somme3 = scalar @match3;
print "Regex : $regex_join\n";
print "Match3 : @match3\n"; 
print "Somme3 : $somme3\n\n";
 
__END__

Motif : CAA (0)
Match :
Motif : CAT (1)
Match : CAT
Motif : CAC (0)
Match :
Motif : CTA (0)
Match :
Motif : CTT (1)
Match : CTT
Motif : CTC (1)
Match : CTC
Motif : CCA (0)
Match :
Motif : CCT (2)
Match : CCT CCT
Motif : CCC (0)
Match :
Somme : 5

Regex : m{C[ATC][ATC]}g
Match2 : CAT CCT CCT
Somme2 : 3

Regex : CAA|CAT|CAC|CTA|CTT|CTC|CCA|CCT|CCC
Match3 : CAT CCT CCT
Somme3 : 3

On remarque que la somme n'est pas de 5 mais 3.

Merci

[Schmorgluck]

Je vois une solution possible à ton problème.
Elle consiste à forcer la position de fin de la dernière reconnaissance au moyen de pos et de démarrer la régex avec l'ancre \G.

Code :

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

1
2
3
4
5
for my $position(0..(length $sequence)-3)
{
  pos($sequence)=$position;
  $somme++ if($sequence=~/\GC[ACT]{2}/g);
}

On peut envisager une autre solution impliquant un test avant.

Code :

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

my $somme = scalar ($sequence=~/C(?=[ACT]{2})/g);

Et il y en a sans doute d'autres plus élégantes.

[Philou67430]

J'ai cherché une solution sur la base de la même idée que toi, mais sans la trouver ...

[Philou67430]

Grâce à Schmorgluck, voici une version qui devrait être un peu plus efficace : on ne repositionne le pointeur de la regexp qu'après avoir trouvé un motif (en reculant de length($motif_trouvé) - 1).

Code :

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

1
2
3
4
5
6
7
8
while ($sequence =~ m{\G.*?($regex_join)}g) {
  push @match4, $1;
  pos($sequence) -= length($match4[-1]) - 1;
}
my $somme4 = scalar @match4;
print "Regex : \\G.*.($regex_join)\n";
print "Match4 : @match4\n"; 
print "Somme4 : $somme4\n\n";

J'ai souvent du mal à utiliser pos et \G...

[djibril]

Pouvez vous donner une explication de pos et de \G. Cela pourrait aider toutes les personnes ne les connaissant pas.

[djibril]

pos
Retourne l'offset (l'index du caractère dans la chaîne) où s'est arrêté la dernière recherche m//g sur la variable SCALAIRE spécifiée (s'appliquera à $_ si la variable SCALAIRE n'est pas spécifiée). Notez que 0 est un offset valide. unde indique que la position de recherche a été réinitialisée (habituellement suite à une recherche infructueuse mais aussi, évidemment, si aucune recherche n'a encore été effectuée sur le scalaire). pos accède directement à l'emplacement où le moteur d'expression rationnelle stocke son offset si bien que l'affectation d'une valeur à pos modifiera cet offset et influencera donc l'assertion de longueur nulle \G d'une expression rationnelle. Comme l'échec d'un recherche par m//gc ne réinitialise pas l'offset, la valeur retournée par pos ne changera pas das ce cas. Voir la page de manuel perlre et la page de manuel perlop.

[djibril]

Sinon, en me basant sur ta solution philou, je pense que ce code est plus correct :

Code :

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

1
2
3
4
while ($sequence =~ m/\G.*?(C[ATC]{2})/g) {
  push @match4, $1;
  pos($sequence) -= length($match4[-1]) - 1;
}

Car celle que tu utilises oblige de trouver au préalable toutes les possibilités de motifs. Du coup on perd l'avantage de la regex. Qu'en penses tu ?

[Philou67430]

Dans le script que j'ai placé au dessus, le \G spécifie au moteur d'exécution des regexp à quel endroit il doit redémarrer la recherche dans le cas de l'usage du modificateur /g.
Je précise donc qu'il faut chercher un motif après un nombre quelconque de caractère situé après la position courante de recherche (qui par défaut, se trouve après le dernier motif trouve), et lorsque l'on trouve un motif, je recule le pointer de la taille du motif trouvé moins un caractère, l'incitant à cherche un motif enchevêtré avec celui que l'on vient juste de trouver.

[Philou67430]

Du coup on perd l'avantage de la regex. Qu'en penses tu ?

On peut, bien sur, mais après profilage, la différence n'est pas essentielle (les regexp sont de toute manière compilées).
Par ailleurs, la simplification manuelle n'est pas réalisable de manière générique (c'est à dire en disposant d'une liste de motifs quelconque). Ceci me permet d'introduire le module Regexp::Assemble qui permet justement de construire et réduire une regexp (qui ne sera cependant pas aussi simplifiée que celle proposée dans le cas présent, mais qui a l'avantage d'être générique).

Exemple :

Code :

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

1
2
3
my $re = Regexp::Assemble->new();
$re->add(@motifs);
while ($sequence =~ m{\G.*?($re)}g) ...

J'ai alors testé le code de Schmorgluck et le mien en profilant, et en modifiant la chaine de recherche (j'ai simplement concaténé 100x la même chaine à la suite), et j'ai comparé le résultat à la recherche initiale de stoyak. Voici le script :

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
#!/usr/bin/perl
 
use strict;
use Carp;
use warnings;
 
my $sequence = 'CATCCTCCTTAAGC' x 100;
my $somme = 0;
my @motifs = qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
my $repeat = $ARGV[0] // 100;
my $repeat2 = $ARGV[1] // 100;
 
my @match;
sub a {
  foreach (1 .. $repeat) {
    @match = ();
    $somme = 0;
    foreach my $motif ( @motifs ) {
      push @match, $sequence =~ m{$motif}g;
    }
    $somme = @match;
  }
}
a foreach 1 .. $repeat2;
print "Regex : ".(join " et ", map "m{$_}", @motifs), "\n";
print "Match : @match\n";
print "Somme : $somme\n\n";
 
if (0) {
  @match = ();
  @match = $sequence =~ m{C[ATC][ATC]}g;
  $somme = scalar @match;
  print "Regex : m{C[ATC][ATC]}g\n";
  print "Match : @match\n";
  print "Somme : $somme\n\n";
 
  my $regex_join = join('|', @motifs);
  @match = $sequence =~ m{$regex_join}g;
  $somme = scalar @match;
  print "Regex : $regex_join\n";
  print "Match : @match\n";
  print "Somme : $somme\n\n";
}
 
#print { *STDOUT } ((0 .. 9) x 2), "\n", $sequence, "\n";
use Regexp::Assemble;
 
my $re = Regexp::Assemble->new();
$re->add(@motifs);
sub b {
  foreach (1 .. $repeat) {
    @match = ();
    $somme = 0;
    while ($sequence =~ m{\G.*?($re)}g) {
      push @match, $1;
      pos($sequence) -= length($match[-1]) - 1;
    }
    $somme = scalar @match;
  }
}
 
b foreach 1 .. $repeat2;
print "Regex : \\G.*?$re)\n";
print "Match : @match\n";
print "Somme : $somme\n\n";
 
sub c {
  foreach (1 .. $repeat) {
    @match = ();
    $somme = 0;
    for my $position(0..(length $sequence)-3)
      {
        pos($sequence)=$position;
        push @match, $1 if ($sequence=~/\G(C[ACT]{2})/g);
      }
    $somme = scalar @match;
  }
}
 
c foreach 1 .. $repeat2;
print "Regex : \\G(C[ACT]{2})\n";
print "Match : @match\n";
print "Somme : $somme\n\n";
 
print "END\n";
__END__

Voici le résultat :

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
perl -d:DProf regexp-backtrack.pl 1000 1 && dprofpp  -I
...
END
Total Elapsed Time = 4.149281 Seconds
  User+System Time = 3.872281 Seconds
Inclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c  Name
 108.   4.183  4.216      1   4.1828 4.2159  main::b
 55.2   2.141  2.141      1   2.1410 2.1410  main::c
 28.6   1.110  1.110      1   1.1100 1.1100  main::a
 3.18   0.046  0.123      4   0.0115 0.0307  main::BEGIN
 0.85   0.034  0.033 600001   0.0000 0.0000  Regexp::Assemble::__ANON__
 0.83   0.016  0.032      8   0.0020 0.0040  Regexp::Assemble::BEGIN
 0.80   0.015  0.031      7   0.0021 0.0044  IO::File::BEGIN
 0.77       -  0.030      5        - 0.0060  Storable::BEGIN
 0.41   0.016  0.016      3   0.0053 0.0053  warnings::register::import
 0.41       -  0.016      6        - 0.0027  constant::BEGIN
 0.41   0.016  0.016      5   0.0032 0.0031  IO::Seekable::BEGIN
 0.39   0.015  0.015      3   0.0050 0.0050  DynaLoader::dl_load_file
 0.39       -  0.015      1        - 0.0150  DynaLoader::bootstrap
 0.00       -  0.000      3        - 0.0000  Exporter::Heavy::heavy_export
 0.00   0.000  0.000      1   0.0000 0.0000  Config::launcher

On notera que les deux algos (celui de schmorgluck et le mien) donnent des résultats bien inférieurs à la recherche "motif par motif" (et la recherche de schmorgluck 2x meilleur que la mienne). Ceci indique donc que, plus l'expression régulière est simple, plus elle est efficace. Il vaut donc mieux faire 50 recherches d'un motif simple (sans backtracking), que 1 recherche contenant les 50 motifs (avec backtracking manuel).

[stoyak]

Merci à tous pour vos réponses expertes! Cela me conforte sur le fait que cette question n'est pas si triviale!

Je teste cet après-midi!

Merci encore!

[Schmorgluck]

Pour info, j'ai testé ma version avec test avant (en la corrigeant, je m'étais foiré sur la gestion des contextes (faut que je prenne l'habitude te tester mes propositions avant de les poster)) :

Code :

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

$somme = ()=$sequence=~/C(?=[ACT]{2})/g;

Les résultats sont meilleurs que ma version avec manip de pos, mais toujours un peu moins bons que la recherche motif par motif.

[Philou67430]

Comme quoi, la simplicité n'est pas toujours là où l'on croit

[djibril]

Je pense qu'il serait intéressant de faire un résumé assez clair des codes que l'on peut utiliser résoudre ce souci car au final, on se perd dans les messages .

1. Solution la plus efficace en listant les motifs (Djibril)
   

   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
   #!/usr/bin/perl
   use strict;
   use Carp;
   use warnings;
    
   my $sequence = 'CATCCTCCTTAAGC';
   my $somme = 0;
   my @motifs = qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
    
   foreach my $motif ( @motifs ) {
     my @match = $sequence =~ m{$motif}g;
     my $nbr = scalar @match;
     $somme += $nbr;
     print "Motif : $motif ($nbr)\n"; 
     print "Match : @match\n"; 
   }
   print "Somme : $somme\n\n";

   Cette solution a l'air plus simple et rapide, mais l'inconvénient est qu'il faut connaitre tous les motifs que l'on veut.
   
   
2. Utilisation d'une seul regex, pour trouver la somme (Schmorgluck)
   

   Code :

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

   1
   2
   3
   4
   5
   6
   7
   8
   9
   10
   11
   #!/usr/bin/perl
   use strict;
   use Carp;
   use warnings;
    
   my $sequence = 'CATCCTCCTTAAGC';
   my $somme = 0;
   my @motifs = qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
    
   my $NbrMotifTrouves = () = $sequence=~/C(?=[ACT]{2})/g;
   print "Nombre motifs : $NbrMotifTrouves \n";

   Mais avec cette méthode, il est impossible de lister les motifs trouvés. Il serait intéressant d'expliquer ce que veut dire ?=
   
   
3. Utilisation de pos et des regex (philou)
   
   

   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
   #!/usr/bin/perl
   use strict;
   use Carp;
   use warnings;
    
   my $sequence = 'CATCCTCCTTAAGC';
   my $somme = 0;
   my @motifs = qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
    
   my $regex = qr /\G.*?(C[ATC]{2})/;
   my @match;
   while ($sequence =~ m/$regex/g) {
     push @match, $1;
     pos($sequence) -= length($match[-1]) - 1;
   }
   my $somme = scalar @match;
   print "Regex : $regex\n";
   print "Match : @match\n"; 
   print "Somme : $somme\n\n";

   Cette méthode permet également de calculer le nombre de motifs et de les lister. Mais elle reste plus longue que la méthode motif par motif d'après le profilage de philou.

En résumé, Si la séquence de base est petite, je pense que les 3 méthodes sont correctes. Néanmoins, si la séquence est très grande et qu'il est susceptible de trouver beaucoup de motifs (centaine de milliers), je pense qu'il est préférable d'utiliser la méthode motif/motif. Il faudra cependant faire une procédure pour déterminer tous les motifs à rechercher.

Voilà, compléter ou corriger mes propos s'ils sont inexactes.

Merci

[Schmorgluck]

J'ajouterais que si la séquence est très longue, on peut envisager de lui appliquer la fonction interne study, qui peut améliorer les performances dans certains cas (mais qui peut les empirer si la chaîne est courte).

Quant à (?=[ACT]{2}), il s'agit d'un test avant, qui vérifie ce qui le suit dans la chaîne, sans que cette vérification fasse partie de la reconnaissance proprement dite.

EDIT: Je viens de découvrir un problème avec ta solution, Djibril. Si deux motifs de même type se chevauchent, ça ne marche plus. Cela peut se produire avec CCC, CGC et CTC. Par exemple, avec la séquence "CATCTCTCCTTAAGC", on se retrouve avec 4 résultats au lieu des 5 attendus, parce que deux CTC se chevauchent là où j'ai mis en gras, et le deuxième n'est donc jamais reconnu.

[djibril]

Décidément, on est pas rendu

[Philou67430]

Tu n'as pas inclus l'usage de Regexp::Assemble qui peut devenir indispensable si la liste des motifs à chercher est longue et que la réduction n'est pas triviale. J'ajoute d'ailleurs qu'il faudrait aussi faire la même étude de profilage avec une liste de motifs plus importante et moins réductible pour comparer les 3 méthodes.

[djibril]

En effet, j'ai oublié. Je la rajouterais

[djibril]

Bon, je pense que la solution la plus adéquate est la suivante :

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
#!/usr/bin/perl
use strict;
use warnings;
use Regexp::Assemble;
 
my $sequence = 'CATCTCTCCTTAAGC';
my $somme    = 0;
my %motifs   = map { $_ => 0 } qw/CAA CAT CAC CTA CTT CTC CCA CCT CCC/;
 
my $re = Regexp::Assemble->new();
$re->add( keys %motifs );
 
$somme = 0;
while ( $sequence =~ m{\G.*?($re)}g ) {
  $motifs{$1}++;
  pos($sequence) -= length($1) - 1;
}
 
foreach my $motif ( sort keys %motifs ) {
  print "$motif : $motifs{$motif}\n";
  $somme += $motifs{$motif};
}
print "Somme : $somme\n\n";

L'utilisation du module Regexp::Assemble permet d'avoir une expression régulière la plus optimale. La recherche motif par motif est la plus simple, efficace et de plus permet de comptabiliser individuellement chaque motif trouvé.

[Philou67430]

L'utilisation du module Regexp::Assemble permet d'avoir une expression régulière la plus optimale.

Ce n'est pas ce que j'ai constaté. C'est une expression régulière réduite, mais pas forcément optimale. Notamment, lors du profilage que j'ai réalisé, la regexp fournie par Regexp::Assemble était moins rapide que la regexp de Schmorgluck, tout en matchant les mêmes mots.
En revanche, si l'on sort de l'exemple présent, ce module peut devenir le seul à assembler et à réduire une liste de mots (à la main, ça deviendrait trop complexe).

[stoyak]

Merci à Tous!

Je me suis basée sur la dernière solution proposée par djibril. C'est parfait! Le résultat est exact, et même appliquée sur un génome entier, le temps d'exécution reste raisonnable!
Encore merci!