fonction récursive sur string

Version imprimable

Bonjour,

J'ai une séquence, par exemple TYART et j'aimerais trouver toutes les combinaisons possibles de séquences ne contenant que des A, T, C ou G. Donc, il faudrait trouver TTAGT, TCAGT, TTAAT et TCAAT

Code:

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
#!/usr/local/bin/perl
 
use strict;
use warnings;
 
my $amorce = 'ATGGTMCAGATTCRCHTTC ';
my @a_amorces = split ('', $amorce);
my %h_amorces;
 
my %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T'],
    );
 
my $amorce_cle;
 
foreach my $nucleotide (@a_amorces){
 
    if  (exists $correspondances{$nucleotide}){
        my @a_degenerescence = $correspondances{$nucleotide};
        foreach my $deg (@a_degenerescence){
            push (@a_amorces_cles, $amorce_cle.$deg);
        }
    }
    else{
        $amorce_cle .= $nucleotide;
    }
}

Je pense que je suis partie vers une mauvaise voie et qu'il devrait y avoir moyen de créer une fonction récursive mais je ne sais pas par où commencer. Pourriez-vous m'aider s'il vous plait?

Merci beaucoup,

10/07/2008, 14h23
CKLN00

pour info le code (pour coder les bases génétiques) que tu utiliser est de l'IUB/IUPAC j'ai trouver quelque résultats qui me semblent peu probant sur le CPAN mais c'est l'occasion de faire un petit module de traduction pour le CPAN Jasmine, je suis sur que tu as le niveau nécessaire pour ça ;)

pour ce qui est de t'aider dans l'implémentation la je suis un peu surcharger, mais j'essayerais de m'y pencher dans la journée !

Voici ce que j'ai déjà écrit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
sub recup_amorce{
    my $ref_amorce = $_[0];
    my $amorce_cle = $_[1];
    foreach my $nucleotide (@{$ref_amorce}){
 
        if  (exists $correspondances{$nucleotide}){
            my @a_degenerescence = $correspondances{$nucleotide};
            foreach my $deg (@a_degenerescence){
                $amorce_cle .= $deg;
                recup_amorce($ref_amorce, $amorce_cle)
            }
        }
 
        else{
            $amorce_cle .= $nucleotide;
        }
    }
}

Mais j'obtiens le message d'erreur suivant

Citation:

Deep recursion on subroutine "main::recup_amorce" at P:\Perl\scripts2\MANIPS~1\CONSEN~1.PL line 39.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
my %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T'],
    );
 
my @a_degenerescences = $correspondances{'R'};
map{print "$_\n";} @a_degenerescences ;

Je n'arrive pas à récupérer les valeur de l'array ... c'est tellement stupide que ça m'énerve.

Cela fonctionne avec

Code:

1
2
3
4
my @a_degenerescences = $correspondances{'R'};
foreach my $array ( @a_degenerescences){
    map{print "$_\n";} @{$array} ;
}

mais cela devient compliqué :(

10/07/2008, 15h13
CKLN00

$correspondances{'R'}; contien un Scalaire (comme le $ au début l'indique) mais c'est un Référence à un tableau qui lui meme contien le scalaire A et le scalaire G.
donc pour obtenire la liste de scalaire correspondant à 'R' il faut faire par exemple : print @{$correspondances{'R'}} ;

Edit :

Citation:

Envoyé par Jasmine80

mais cela devient compliqué :(

bha normal les structures complex (un Hash de tableau ici) sont ... pas simple ;) à manipulé puisqu'en fait les Hash et tableau ne contiennent que des scalaire !
il faut comprendre qu'en fait un tableau de tableau n'est en fait qu'un tableau conteant des références vers d'autres tableau mais je pense que cela est bien mieux expliquer dans la :faq:

Code:

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
#!/usr/local/bin/perl
 
 
 
use strict;
use warnings;
 
my $amorce = 'ATGGTMCAGATTCRCHTTC';
my @a_amorce = split ('', $amorce);
 
 
 
 
my %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T'],
    );
 
 
 
my $amorce_cle = '';
my @a_recup;
 
recup_amorce ($amorce, $amorce_cle );
 
map {print "=> ".$_."\n";}@a_recup;
 
sub recup_amorce{
 
    # amorce de départ
    my $amorce = $_[0];
    # début déjà créé de l'amorce sans les dégénérescences
    my $amorce_cle = $_[1];
    # longueur de l'amorce clé
    my $l = length($amorce_cle);
    # on récupère la fin de $amorce qui n'a pas encore été traitée
    my $restant = substr ($amorce, $l);
 
    print "$amorce\t$amorce_cle\t$restant\n";
 
    # si il reste encore des nucléotides à traiter
    if(length($restant) > 0){
        my @a_nucleotides = split ('', $restant);
 
        # pour chacun des nucléotides, on regarde si il faut le traiter ou non
        foreach my $nucleotide (@a_nucleotides){
 
            # si le nucléotide est une base dégénérées
            if  (exists $correspondances{$nucleotide}){
 
                # on va récupérer toutes les valeurs possibles
                foreach my $deg (@{$correspondances{$nucleotide}}){
                    $amorce_cle .= $deg;
                    recup_amorce($amorce, $amorce_cle);
                }
            }
 
            # si le nucléotide ne doit pas être modifié
            # on l'ajoute tel quel
            else{
                $amorce_cle .= $nucleotide;
            }
        }
    }
    # séquence de l'amorce terminée
    # récupération dans un array
    else{
        push (@a_recup, $amorce_cle);
    }
}

Cela progresse petit à petit

recursivité problématique

bon alors j'ai un peu bosser sur ton problème jasmine (mais je n'ai pas bien regarder ton code je l'avoue :p)

et j'ai pondu ça (les commentaire sont à droites) :

Code:

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
#!/usr/bin/perl -w
use strict;
my $amorce = 'TYAB';
our %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T']
    );
 
#print "pour l'amorces $amorce on trouve les résultats suivants :\n\n" ;
my @listPossibilitees = &core($amorce) ;
#print "\n\n@listPossibilitees \n";
 
print "\nfin" ;
#<STDIN> ;
 
sub core
{
  print "Début d'une sous routine :\n" ;                                        # on signale le début de "core".
  my $amorce = shift ;
  my @resultats = () ;
  if ($amorce =~ /([ACGT]*)([RKSWMYDVBHN])(\w*)/i)                              # on cherche un nucléotide dégénéré.
  {
    foreach my $alternatives (@{$correspondances{$2}})                          # pour chaque alternative de ce nucléotide.
    {
      print "début du traitement de ",$1,$alternatives,$3,"\n";                 # on note la séquence que l'on commence à
                                                                                # traiter.
 
      my @tmp = &core($1.$alternatives.$3) ;                                    # on rappele en récursivité "core".
 
      print("\@tmp: @tmp\n");                                                   # on affiche le résultat de la
      push(@resultats,@tmp);                                                    # sous-routine que l'on ajoute à notre
                                                                                # propre liste de résultat.
 
      print "fin du traitement de ".$1.$alternatives.$3."\n";                   # on signale la fin du traitement de la
                                                                                # séquence.
    }
  }
  else
    {@resultats = ($amorce) ;}                                                  # si pas de nucléotide dégénérer on
                                                                                # retourne simplement l'amorce inchangée.
 
  print "Fin d'une sous routine\n";                                             # pour plus de clarté dans la lecture on
                                                                                # signale la fin d'une sous routine
  return @resultats ;
}

qui m'affiche ça (indenté et numéroté pour plus de clartée) :

Code:

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
Début d'une sous routine : (0 = main)
  début du traitement de TCAB     <======= note 1
  Début d'une sous routine : (1)
    début du traitement de TCAC
    Début d'une sous routine : (2)
    Fin d'une sous routine (2)    <======= sous routine qui commence et finit tout de suite : c'est une sous routine qui à reçu une séquence nucléotidique sans dégénération (que ACGT) 
    @tmp: TCAC
    fin du traitement de TCAC
    début du traitement de TCAG
    Début d'une sous routine : (3)
    Fin d'une sous routine (3)
    @tmp: TCAG
    fin du traitement de TCAG
    début du traitement de TCAT
    Début d'une sous routine : (4)
    Fin d'une sous routine (4)
    @tmp: TCAT
    fin du traitement de TCAT
  Fin d'une sous routine (1)
  @tmp: TCAC TCAG TCAT
  fin du traitement de TCAC     <======= Différence avec note 1 ! on devrais avoir TCAB
  début du traitement de TCAT   <======= Problème ! on devrais commencer à traiter TTAB
  Début d'une sous routine : (5)
  Fin d'une sous routine (5)
  @tmp: TCAT
  fin du traitement de TCAT
Fin d'une sous routine (0 = main)

je ne comprend pas les abérations de ce résultat :(
je pensait que cet algorithme était fonctionelle :(

si quelqu'un peu nous aider ça serais sympas !!

Edit : je supposais que le problème venais du partage des variables et j'avais raison :
en utilisant des threads le programme fonctionne bien :yaisse2:

Code:

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
#!/usr/bin/perl -w
use strict;
use threads ;
my $amorce = 'TYART';
our %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T']
    );
 
print "pour l'amorces $amorce on trouve les résultats suivants :\n" ;
my @listPossibilitees = &core($amorce) ;
print "@listPossibilitees\n";
 
print "\nfin" ;
#<STDIN> ;
 
sub core
{
  my $amorce = shift ;
  my @resultats = () ;
  if ($amorce =~ /([ACGT]*)([RKSWMYDVBHN])(\w*)/i)                              # on cherche un nucléotide dégénéré.
  {
    foreach my $alternatives (@{$correspondances{$2}})                          # pour chaque alternative de ce nucléotide.
    {
      my ($thr) = threads->create(\&core,$1.$alternatives.$3) ;                 # on rappele en récursivité "core" avec
      push(@resultats,$thr->join()) ;                                           # des threads pour éviter le partages des
                                                                                # données et on ajoute les résultat de la
                                                                                # sous-routine core à notre propre liste
                                                                                # de résultat.
    }
  }
  else
    {@resultats = ($amorce) ;}                                                  # si pas de nucléotide dégénérer on
                                                                                # retourne simplement l'amorce inchangée.
  return @resultats ;
}

alors il est surement possible de faire mieux mais je commençais juste a étudier le module de threads après avoir eut ce problème et c'était le moyen le plus simple que j'ai trouver pour éviter le partage de variables :)

14/07/2008, 08h14
Jasmine80

Merci beaucoup CKL00, cela fonctionne très bien. Je vais me pencher sur le module threads afin de bien comprendre le fonctionnement.
14/07/2008, 15h52
CKLN00

en fait je pense que j'utilise le module thread abusivement : il me sert juste à faire en sorte que les appelles récursif de ma fonction ne se mélange pas dans les variables

Sur que créer des threads à chaque appel récursif, c'est pas la joie...

Code:

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
#!/usr/bin/perl
use strict; use warnings;
 
my $amorce = 'TYARTN';
my %correspondances =
    (
            'R' => ['A', 'G'],
            'K' => ['G', 'T'],
            'S' => ['C', 'G'],
            'W' => ['A', 'T'],
            'M' => ['A', 'C'],
            'Y' => ['C', 'T'],
            'D' => ['A', 'G', 'T'],
            'V' => ['A', 'C', 'G'],
            'B' => ['C', 'G', 'T'],
            'H' => ['A', 'C', 'T'],
            'N' => ['A', 'C', 'G', 'T']
    );
 
print "pour l'amorces $amorce on trouve les résultats suivants :\n" ;
core( sub { print "$_\n" }, $amorce) ;
 
print "fin\n" ;
 
sub core
{
  my ($code, $amorce) = @_ ;
 
  if ( my ($start, $middle, $end) = ($amorce =~ /^([ACGT]*)([RKSWMYDVBHN])(\w*)$/i) )  {
    foreach my $alt (@{$correspondances{$middle}}) {
      core( $code, "$start$alt$end" );
    }
  }
  else {
    local $_ = $amorce ;
    $code->();
  }
}
 
__END__

Cette solution est à la fois plus souple et efficace : elle se contente d'appeler une fonction avec chaque séquence alternative au lieu de collecter toutes les possibilités dans une unique liste, c'est la plupart du temps amplement suffisant et cela consomme nettement moins de ressources, de plus si on a vraiment besoin de la liste il est aisé de la faire constituer par notre fonction.
De plus bien sûr, ce programme ne crée pas des threads à tout va et se contente d'une récursion propre et sûre...

--
Jedaï

14/07/2008, 22h32
Jedai

Citation:

Envoyé par Jasmine80

Merci beaucoup CKL00, cela fonctionne très bien. Je vais me pencher sur le module threads afin de bien comprendre le fonctionnement.

Ne fais pas ça please, reste en séquentiel, le parallélisme à base de threads c'est systématiquement la m**** et d'autant plus en Perl qui n'a pas été prévu à la base pour ça.

--
Jedaï
14/07/2008, 22h40
CKLN00

dans ce cas ? !

dans ce cas la qu'est que tu nous conseille de faire quand on veut utiliser de la récursivité tout en évitant que les variables de mes différentes instances de ma sous-routine se mélange les variables ???

Et il me semblais que depuis perl 5.6 justement Perl gérais correctement le parallélisme non ?

et si non pour faire du parallélisme à par les thread en Perl tu nous conseille quoi ? car la je suis sur un script ou je doit traiter des fichier de plusieurs gigaoctets donc je prévoyais d'utiliser des threads pour faire du parallélisme et accélérer le rythme
14/07/2008, 23h35
Jedai

Citation:

Envoyé par CKLN00

dans ce cas la qu'est que tu nous conseille de faire quand on veut utiliser de la récursivité tout en évitant que les variables de mes différentes instances de ma sous-routine se mélange les variables ???

Vous avez utilisé les variables globales $1, $2 et $3 alors que vous auriez dû utiliser des variables lexicales (déclarées avec my()) comme dans ma solution, qui n'utilise pas de thread, est dans mon opinion plus claire de ce fait et est au moins 30 fois plus rapide (si tu veux mon avis, asymptotiquement c'est encore pire que ça...).
Vous n'avez pas besoin des threads, ici ils vous ont sauvés en rendant les variables globales locales à chaque thread, mais l'erreur à l'origine était d'utiliser des variables globales.

Citation:

Envoyé par CKLN00

Et il me semblais que depuis perl 5.6 justement Perl gérais correctement le parallélisme non ?

et si non pour faire du parallélisme à par les thread en Perl tu nous conseille quoi ? car la je suis sur un script ou je doit traiter des fichier de plusieurs gigaoctets donc je prévoyais d'utiliser des threads pour faire du parallélisme et accélérer le rythme

Des processus, ou pas de parallélisme éventuellement... Le parallélisme n'accélère les choses que quand il profite de plusieurs cores (combien de cores a ta machine ?) ou quand ton programme séquentiel est mal codé et profiterait bien de procédures asynchrones. Si tu veux faire de l'asynchrone en Perl utilise POE, si tu veux profiter de plusieurs cores utilise plusieurs processus.

Les threads sont de toute façon une mauvaise solution à terme, le futur est plutôt du côté des transactions mémorielles (software ou hardware) et des parallélismes implicites.

D'ici là, ne succombe pas à la mode, les threads ne sont pas une solution magique qui accélère tout.

--
Jedaï
15/07/2008, 02h53
CKLN00
tout d'abord merci (je ne te l'ai pas dit avant car je n'avais pas vu que tu avais fait 2 post, honte à moi :p)
en suite par rapport a ta solution, heu j'ai besoin d'aide je ne comprend ni cette partie la :
Code:

1 2 3 4 else { local $_ = $amorce ; $code->(); }
ni l'utilité de la variable $code.
Je viens d'apprendre avec ce code un nouveau moyen d'utiliser les parenthèse de mémorisation (j'avais du oublier qu'il existait la possibilité que tu nous expose car lors de ma lecture de la faq je connaissais déjà l'utilisation de $1,$2,etc.)
donc merci mais si tu pouvais m'éclairer ce que je ne saisit pas encore je t'en serais reconnaissant :)

Citation:

Envoyé par Jedai

Le parallélisme n'accélère les choses que quand il profite de plusieurs cores (combien de cores a ta machine ?) ou quand ton programme séquentiel est mal codé et profiterait bien de procédures asynchrones. Si tu veux faire de l'asynchrone en Perl utilise POE, si tu veux profiter de plusieurs cores utilise plusieurs processus.

"ma" machine à effectivement plein de core (aucune idée du nombre exacte), c'est un cluster de calcul. donc plus tot que de faire des threads tu me conseille d'utiliser plusieurs processus, pour crée plusieur processus la maniere la plus simple est fork() ?
15/07/2008, 03h43
Jedai

$code est une référence sur une subroutine, dans l'application :

Code:

core( sub { print "$_\n" }, $amorce) ;

c'est une référence sur la subroutine anonyme "sub { print "$_\n"; }".
$code est appelé avec chacune des alternatives finales. Avant de l'appeler, je localise la variable globale $_ et lui affecte l'alternative complète ($amorce) de façon à ce que la fonction soit un peu plus jolie que si je la lui passais en paramètre (il faudrait que j'écrive "sub { print "$_[0]\n" }") et, plus important, afin de respecter le quasi-standard qui veut qu'une fonction à un seul paramètre passé en paramètre à une autre fonction ait accès à son paramètre dans $_ (comme dans map ou grep).

Le mot clé "local" est-il mystérieux pour toi ? Il "localise" une variable globale de sorte que à la sortie du bloc celle-ci reprenne la valeur qu'elle avait juste avant d'être localisée, cela évite aux manipulations de variables globales d'influencer de façon imprévue le reste du code.
$code->() est simplement une manière d'appeler la fonction référencée par $code, comme $array_ref->[0] accède à un élément du tableau référencé.

Cette idiome par "callback" est très puissant en Perl parce que les fonctions anonymes et les closures y sont réellement implémentées. Il paraît que le livre "Higher Order Perl" est excellent pour apprendre à programmer de cette façon (et au-delà).

Citation:

"ma" machine à effectivement plein de core (aucune idée du nombre exacte), c'est un cluster de calcul. donc plus tot que de faire des threads tu me conseille d'utiliser plusieurs processus, pour crée plusieur processus la maniere la plus simple est fork() ?

Oui effectivement, néanmoins si tu as déjà des programmes avec des multiples threads qui marchent et sont stables continue à utiliser les threads. La stabilité de l'implémention des threads en Perl dépend pas mal des plateformes. Les threads sont tout de même plus léger que de vrais processus aussi si tu en crées beaucoup, il est préférable qu'il s'agisse de threads. Ton cas est spécial, mais bien souvent l'emploi de threads en Perl est complètement superflu et je me retrouve à devoir expliquer pourquoi il y a plein de messages d'erreurs bizarres...

(NB: Pour profiter pleinement du potentiel de ta machine, on ne peut pas dire que Perl soit un choix idéal cependant, Haskell ou un langage spécialisé serait bien plus approprié)

--
Jedaï

Et bien, il s'en passe des choses la nuit sur ce forum ... et moi qui dormais comme un bébé.

J'ai dû relire plusieurs fois certains passages afin de bien tout comprendre merci beaucoup pour votre aide. Quand, je lis des postes pareils, je me rends compte que je suis encore loin de bien maitriser Perl et cela me motive à apprendre davantage.

J'aimerais savoir si le code suivant est correct

Code:

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
sub Tm
{
        my $Amorce = $_[0];
        my $Ct = $_[1];
        my $Na = $_[2];
        $Amorce = uc($Amorce);
        # si l'amorce dont on veut le tm est dégénérée
        if ($Amorce !~ /^[ATCG]+$/){
            # recherche la liste des amorces correspondantes
            my @liste_amorces;
            core( sub { push (@liste_amorces, $_);}, $Amorce);
            # calcul du tm moyen
            my @a_tm;
            foreach my $amorce (@liste_amorces){
                my $tm = Tm($amorce,$Ct,$Na);
                push (@a_tm, $tm);
            }
            my $moyenne_tm = mean @a_tm;
            return($moyenne_tm);
        }
 
 
        my %dH =
        (
                AA => -9.1,
                TT => -9.1,
                AT => -8.6,
                TA => -6.0,
                CA => -5.8,
                TG => -5.8,
                GT => -6.5,
                AC => -6.5,
                CT => -7.8,
                AG => -7.8,
                GA => -5.6,
                TC => -5.6,
                CG => -11.9,
                GC => -11.1,
                GG => -11.0,
                CC => -11.0,
        );
 
        my %dS =
        (
                AA => -24.0,
                TT => -24.0,
                AT => -23.9,
                TA => -16.9,
                CA => -12.9,
                TG => -12.9,
                GT => -17.3,
                AC => -17.3,
                CT => -20.8,
                AG => -20.8,
                GA => -13.5,
                TC => -13.5,
                CG => -27.8,
                GC => -26.7,
                GG => -26.6,
                CC => -26.6,
        );
 
        my $H = 0;
        my $S = 0;
 
        my $NbScan = length($Amorce)-2+1;
        for(my$i=0; $i<$NbScan; $i++){
                my $N2 = substr($Amorce, $i, 2);
                if((!exists $dH{$N2}) | (!exists $dS{$N2})){
                    die "ERREUR N2 ($N2) $Amorce, $i\n";
                }
                else{
                        $H += $dH{$N2};
                        $S += $dS{$N2};
                }
        }
 
 
        my $Tm = 1000 * $H / ((-10.8 + $S)+1.987*log($Ct/4)) - 273.15 + 16.6*(log($Na)/log(10));
        $Tm = sprintf("%.3f", $Tm);
        return $Tm;
}

Merci beaucoup,

Peut-être est-ce mieux de faire ainsi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
        if ($Amorce !~ /^[ATCG]+$/){
 
            # calcul du tm moyen
            my @a_tm;
 
            core(
                sub {
                        my $tm = Tm($_,$Ct,$Na);
                        push (@a_tm, $tm);
                    },
 
            $Amorce);
 
            my $moyenne_tm = mean @a_tm;
            return($moyenne_tm);
        }

personnellement je ne mettrais pas cette partie
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 if ($Amorce !~ /^[ATCG]+$/){ # recherche la liste des amorces correspondantes my @liste_amorces; core( sub { push (@liste_amorces, $_);}, $Amorce); # calcul du tm moyen my @a_tm; foreach my $amorce (@liste_amorces){ my $tm = Tm($amorce,$Ct,$Na); push (@a_tm, $tm); } my $moyenne_tm = mean @a_tm; return($moyenne_tm); }
dans la sous routine tm.
ce n'est qu'un point de vue tout à fait personnelle, mais je trouve que ça simplifierais la lecture. (après je ne pense pas que ça change grand chose mais sur un plan d'organisation je dirais que c'est mieux ^^)

Et je pense que ta seconde proposition de code est meilleur

oui, peut-être mais de toute façon, je dois revoir ma méthode de calcul moyen du tm car avec des amorces trop dégénérées le programme dérape vite. J'ai ajouté
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 if ($Amorce !~ /^[ATCG]+$/){ # vérification du nombre total de nucléotides à analyser my $primer_nbr = 1; my @liste_deg = $Amorce =~ /([RKSWMYDVBHN])/gi; map{$primer_nbr *= @{$correspondances{$_}};} @liste_deg; my $treatment_nbr = length($Amorce) * $primer_nbr; if ($treatment_nbr > 500000){ return('impossible'); } # recherche la liste des amorces correspondantes my @liste_amorces; core( sub { push (@liste_amorces, $_);}, $Amorce) ; ...
Mais le mieux serait de modifier la formule mathématique afin qu'elle calcule directement la moyenne au lieu de faire la moyenne de ses résultats. Je vais y regarder de plus près afin de voir si cela est faisable ou non.

merci