comparaison de deux séries d'objets

**Jasmine80** · 29/05/2007, 10h52

Bonjour à tous,

J'aimerais poser une question sur la façon de procéder.
J'ai deux séries d'objets ceux de $Pl1 et ceux de $Pl2.
de structure:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
sub new                                                 # fonction est définie
{
        my ($Classe, $Sequence, $Taille, $Enzyme, $Site, $Frequence, $Positions) = @_;
        my $self = {};                                  # référence anonyme vers une table de hachage vide
        bless ($self, $Classe);                         # indique que la référence est liée au package (à la classe)
        $self->{SEQUENCE} = $Sequence;
        $self->{TAILLE} = $Taille;
        $self->{ENZYME} = $Enzyme;
        $self->{SITE} = $Site;
        $self->{FREQUENCE} = $Frequence;
        $self->{POSITIONS} = $Positions;
        return $self;
}
1;

J'aimerais trouver les $self->{ENZYME} n'étant pas en commun pour $Pl1 et $Pl2. Je veux dire que $Pl1 et $Pl2 contiennent toute une série d'objets et je voudrais récupérer ceux n'étant présent que pour l'un d'eux mais aussi qu'en cas de présence $self->{FREQUENCE} (qui est numérique) soit supérieur à 1.

Je ne vois pas comment procéder au plus simple.
Je commence par récupérer mes ENZYMES communes dans @Enz_Communes.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# Recherche des enzymes ne coupant qu'un des deux plasmides et coupant plus d'une fois le second
#---------------------------------------------------------------------------------------------------
 
my @Enz_Communes;
for (my $c =0; $c<$a; $c++)
{
        for (my $d = 0; $d<$b; $d++)
        {
               if ($Pl1[$c]->{ENZYME} eq $Pl2[$d]->{ENZYME})
               {
                 push (@Enz_Communes, $Pl1[$c]->{ENZYME});
               }
        }
}

Ensuite, je peux réappeller chaque objet, ne garder que ceux dont la valeur de ->{ENZYME} ne se trouve pas dans @Enz_Communes et dont ->{FREQUENCE} est supérieur à 1.

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
for (my $c =0; $c<$a; $c++)
{
        my $OK = 0;
        foreach my $Enz(@Enz_Communes)
        {
                if ($Enz eq $Pl1[$c]->{ENZYME}){$OK = 1;}
        }
        if(($OK == 0) && ($Pl1[$c]->{FREQUENCE}>1))
        {
 
        }
}
for (my $d = 0; $d<$b; $d++)
{
        my $OK = 0;
        foreach my $Enz(@Enz_Communes)
        {
                if ($Enz eq $Pl2[$d]->{ENZYME}){$OK = 1;}
        }
        if(($OK == 0) && ($Pl2[$d]->{FREQUENCE}>1))
        {
 
        }
}

Est-ce que le problème est clair?
Est-ce la façon la plus logique de procéder?

Perl possède-t-il une fonction me permettant de vérifier si une valeur existe dans mon array?

Merci beaucoup,

Jasmine,

PS : programmes postés dans http://www.developpez.net/forums/sho...d.php?t=344735

**Jedai** · 29/05/2007, 15h55

Pour vérifier simplement si un objet se trouve dans un tableau, tu as List::Util::first, auquel tu pourrais passer une fonction vérifiant l'égalité de deux de tes objets (ne suffit-il pas de comparer leur nom d'enzyme ?).

Cependant, cette technique n'est pas vraiment adaptée pour effectuer une soustraction ensembliste comme tu te proposes de le faire.
La méthode standard consiste à faire appel à un hash.
Avec cette méthode là par exemple :

Code :

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

1
2
3
4
5
6
sub substract (&\@\@) {
    my ($code, $a, $b) = @_;
    my %temp;
    @temp{map {$code->()} @$b} = ();
    return grep { not exists $temp{$code->()} } @$a;
}

Dans le bout de code suivant je suppose que le nom d'enzyme est caractéristique de l'objet (autrement dit deux objets sont égaux si et seulement si leurs nom d'enzyme sont égaux) :

Code :

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

1
2
3
4
my @Pl1  = ...;
my @Pl2 = ...;
 
my @rest = substract {$_->{ENZYME}} @Pl1, @Pl2;

Une fois que tu as @rest, tu peux simplement faire un grep pour récupérer ceux dont la fréquence est supérieure à 1 :

Code :

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

my @final = grep {$_->{FREQUENCE} > 1} @rest;

Ou alors tu combines les deux :

Code :

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

1
2
3
4
5
6
my @Pl1  = ...;
my @Pl2 = ...;
 
my @rest = 
    grep {$_->{FREQUENCE} > 1}
      substract {$_->{ENZYME}} @Pl1, @Pl2;

--
Jedaï

**Jasmine80** · 30/05/2007, 14h02

Merci beaucoup pour cette réponse. Je n'ai pas encore testé car j'essaie d'abord de comprendre. Pourrais-tu m'expliquer quelques points s'il te plait?

Code :

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

1
2
3
4
5
6
7
 sub substract (&\@\@) {
    my ($code, $a, $b) = @_;
    my %temp;
    @temp{map {$code->()} @$b} = ();   # %temp contiendra les valeurs ENZYME de l'array b
    return grep { not exists $temp{$code->()} } @$a;   # grep renvoie la liste des éléments de l'array b n'existant pas dans %temp
}
my @rest = substract {$_->{ENZYME}} @Pl1, @Pl2;

Je m'y perds dans les crochets et accolades.
Dans substract {$_->{ENZYME}} @Pl1, @Pl2 Pourquoi faut-il des crochets à {$_->{ENZYME}} ? Que vaut $code exactement? $code->() vaut-il $_->{ENZYME}? La variable spéciale $_ vaut chaque élément de la liste un à un.
Et dans @temp{map {$code->()} @$b}
Je ne comprends pas la structure de la hash temp, pourquoi ne pas faire une simple array? du genre @temp = map ({$code->()} @$b)

Merci beaucoup,

Jasmine,

**Jasmine80** · 30/05/2007, 14h59

Je viens d'essayer et cela ne fonctionne pas

J'ai un message d'erreur me disant que la méthode substract ne peut pas être utilisée sur une valeur indéfinie.
Voici la structure de @Pl1:
$Pl1[$a] = Restriction->new ($Plasmide1, $TaillePlasmide1, $Enzyme, $Site , $Frequence, $Positions);
Avec $a commençant à 0 et étant autoincrémenté.

Merci,

Jasmine,

**Jedai** · 30/05/2007, 15h12

Envoyé par Jasmine80

Je viens d'essayer et cela ne fonctionne pas

J'ai un message d'erreur me disant que la méthode substract ne peut pas être utilisée sur une valeur indéfinie.
Voici la structure de @Pl1:
$Pl1[$a] = Restriction->new ($Plasmide1, $TaillePlasmide1, $Enzyme, $Site , $Frequence, $Positions);
Avec $a commençant à 0 et étant autoincrémenté.

Merci,

Jasmine,

Je sais que cette fonction marche parce que je l'ai testée. Ce qui signifie qu'il y a un problème avec tes structures de données. Pourrais-tu me donner l'erreur exacte ?

--
Jedaï

**Jasmine80** · 30/05/2007, 15h21

Cela fonctionne merci,
Cela fonctionne si je fais l'appel ainsi

Code :

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

my @rest = substract(sub { $_->{ENZYME} }, \@Pl1, \@Pl2);

Code :

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

1
2
3
4
5
6
7
8
9
sub substract;
my @Enz_Communes = substract(sub { $_->{ENZYME} }, \@Pl1, \@Pl2);
 
print $Outfile "\n\nListe des enzymes communes\n";
print $Outfile "\n----------------------------\n\n";
foreach my $Enz (@Enz_Communes)
{
        print $Outfile $Enz." ";
}

Sauf que dans mon fichier de sortie j'ai:

Liste des enzymes communes

----------------------------

Restriction=HASH(0x19c06a0) Restriction=HASH(0x19b5474) Restriction=HASH(0x19bd9bc) Restriction=HASH(0x19cc87c) Restriction=HASH(0x19b5b80) Restriction=HASH(0x19b5c40) Restriction=HASH(0x19d01fc) Restriction=HASH(0x19d049c) Restriction=HASH(0x19d1a50) Restriction=HASH(0x19d36f4) Restriction=HASH(0x19d3754) Restriction=HASH(0x19d3874) Restriction=HASH(0x19d3994) Restriction=HASH(0x19d50b0) Restriction=HASH(0x19d5230) Restriction=HASH(0x19d754c) Restriction=HASH(0x19d8b58) Restriction=HASH(0x19d8cd8) Restriction=HASH(0x19d8d38) Restriction=HASH(0x19d8d98) Restriction=HASH(0x19d8df8) Restriction=HASH(0x19d8e58) Restriction=HASH(0x19d8eb8) Restriction=HASH(0x19da954) Restriction=HASH(0x19daa74)

en utilisant

my @Enz_Communes = substract {$_->{ENZYME}} @Pl1, @Pl2;

J'obtiens:

Can't call method "substract" on an undefined value at P:\Perl\scripts\MANIPU~1\RESTRI~1\test.pl line 268, <FileTxt2> line 667.

Voici mon code:

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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
#!/usr/bin/perl
 
 
 
#-------------------------------- ComparaisonRestrictions.pl ------------------------------------#
#       Ce programme prend en entrée deux fichiers textes contenant les informations de cartes   #
#       de restriction générées par BioEdit et donne les enzymes coupant un nombre différent     #
#       de fois ces deux séquences                                                               #
#------------------------------------------------------------------------------------------------#
 
 
=h
FICHIER D ENTREE
 
BioEdit version 7.0.5.3 (10/28/05) Restriction Mapping Utility
(c)1998,  Tom Hall
 
WeeTopo Restriction Map
24/05/2007 15:12:02
5220 base pairs
Translations:  none
 
 
Restriction table:
 
Enzyme    Recognition                   frequency  Positions
__________________________________________________________________________
AatII     G_ACGT'C                      1          523
AccI      GT'mk_AC                      1          523
Acc65I    G'GTAC_C                      1          1391
AflIII    A'CryG_T                      2          882, 1021
AleI      CACnn'nnGTG                   1          862
AlwI      GGATCnnnn'n_                  2          239, 451
ApoI      r'AATT_y                      1          623
AvaI      C'yCGr_G                      1          1687
BaeI      ACnnnnGTAyCnnnnnnn_nnnnn'     1          320
BaeI      GrTACnnnnGTnnnnnnnnnn_nnnnn'  1          287
BanI      G'GyrC_C                      2          838, 1391
BanII     G_rGCy'C                      1          1150
BbsI      GAAGACnn'nnnn_                4          334, 1129, 1497, 1525
BbvI      GCAGCnnnnnnnn'nnnn_           9          435, 715, 894, 962, 993, 1123
                                                   1308, 1529, 1639
BceAI     ACGGCnnnnnnnnnnnn'nn_         1          947
BfrBI     ATG'CAT                       1          354
 
 
 
 
 
 
=cut
 
 
 
use strict;
use warnings;
use FileHandle;
use Time::localtime;
use Data::Dumper;
use Restriction;
 
# Paramètre de temps
#---------------------
my $Depart = ctime();
 
 
 
# Paramètre des fichiers
#---------------------------
my $File1 = "RestrictionTest1";
my $File2 = "RestrictionTest2";
my $InFile1 = "P:/Perl/scripts/Files/$File1.txt";
my $InFile2 = "P:/Perl/scripts/Files/$File2.txt";
my $Outfile = FileHandle->new (">P:/Perl/scripts/Files/ComparaisonRestrictions.txt");
 
 
 
 
# Ouverture des fichiers
#------------------------
open (FileTxt1,"$InFile1")  or die "Can't open file1\n";
open (FileTxt2,"$InFile2")  or die "Can't open file2\n";
 
 
 
# Lecture des fichiers de restriction
#--------------------------------------
 
my $Ligne;
my $Plasmide1 ="";
my $Plasmide2="";
my $TaillePlasmide1 = "";
my $TaillePlasmide2 = "";
my @Pl1 ="";
my @Pl2 ="";
 
my $Enzyme;
my $Site;
my $Frequence;
my $Positions;
my $a=-1;
while ($Ligne =<FileTxt1>)
{
 
                if($Ligne =~ /^(\w+)\s+Restriction Map$/)
                {
                        $Plasmide1 = $1;
                }
                if($Ligne =~ /^(\d+)\s+base pairs$/)
                {
                        $TaillePlasmide1 = $1;
                }
                if($Ligne =~ /^(\w+)\s+([\w\']+)\s+(\d{1,2})\s+([\,\d\s]+)$/)
                {
 
                        # structure du fichier texte où on récupère les données
                        # 3 objets à créer : BbsI, BbvI et BceAI
                        # BbsI      GAAGACnn'nnnn_                4          334, 1129, 1497, 1525
                        # BbvI      GCAGCnnnnnnnn'nnnn_           9          435, 715, 894, 962, 993, 1123
                        #                                                   1308, 1529, 1639
                        # BceAI     ACGGCnnnnnnnnnnnn'nn_         1          947
                        # nb certaines enzymes comme BbvI  possèdent ses informations sur plus d'une ligne
                        # il faut donc attendre d'avoir récupérer toutes les lignes avant de créer l'objet
                        # Solution : à chaque fois que l'on rencontre une nouvelle enzyme on sait que la lecture des
                        # informations de l'enzyme précédente est terminée
                        #  On peut donc créer un objet pour l'enzyme précédente
                        #  On ne passe pas dans ce if lors de la première enzyme trouvée
                        # (car évidemment il n'existe pas d'enzyme précédente)
 
                        if($a>-1)
                        {
                                $Pl1[$a] = Restriction->new ($Plasmide1, $TaillePlasmide1, $Enzyme, $Site , $Frequence, $Positions);
                                # print $Pl1[$a]->{ENZYME}."\t".$Pl1[$a]->{FREQUENCE}."\t".$Pl1[$a]->{POSITIONS}."\n";
                        }
                        # récupération des informations
                        $Enzyme = $1;
                        $Site = $2;
                        $Frequence = $3;
                        $Positions = $4;
                        chomp($Positions);
 
                        # compte du nombre d'enzyme (et donc d'objets) différents
                        $a++;
 
                }
                # récupération des positions étant écrites sur plus d'une ligne
                if(($Ligne =~ /^\s*([\,\d\s]+)$/) && ($Ligne !~ /^\s*$/))
                {
                        $Positions = $Positions.", ".$1;
                        chomp($Positions);
                }
                # On quitte la boucle quand l'on arrive à la ligne "Enzymes that cut five or fewer times" du fichier
                if ($Ligne =~ /Enzymes that cut five or fewer times/)
                {
                        last;
                }
}
# pour le dernier objet
$Pl1[$a] = Restriction->new ($Plasmide1, $TaillePlasmide1, $Enzyme, $Site , $Frequence, $Positions);
 
 
# même procédure pour le second fichier
my $b=-1;
while ($Ligne =<FileTxt2>)
{
 
                if($Ligne =~ /^(\w+)\s+Restriction Map$/)
                {
                   $Plasmide2 = $1;
                }
                if($Ligne =~ /^(\d+)\s+base pairs$/)
                {
                   $TaillePlasmide2 = $1;
                }
                if($Ligne =~ /^(\w+)\s+([\w\']+)\s+(\d{1,2})\s+([\,\d\s]+)$/)
                {
 
                        if($b>-1)
                        {
                                $Pl2[$b] = Restriction->new ($Plasmide2, $TaillePlasmide2, $Enzyme, $Site , $Frequence, $Positions);
                                #print $Pl2[$b]->{ENZYME}."\t".$Pl2[$b]->{FREQUENCE}."\t".$Pl2[$b]->{POSITIONS}."\n";
                        }
                        # récupération des informations
                        $Enzyme = $1;
                        $Site = $2;
                        $Frequence = $3;
                        $Positions = $4;
                        chomp($Positions);
 
                        # compte du nombre d'enzymes (et donc d'objets) différents
                        $b++;
 
                }
                # récupération des positions étant écrites sur plus d'une ligne
                if(($Ligne =~ /^\s*([\,\d\s]+)$/) && ($Ligne !~ /^\s*$/))
                {
                        $Positions = $Positions.", ".$1;
                        chomp($Positions);
                }
 
 
}
# pour le dernier objet
$Pl2[$b] = Restriction->new ($Plasmide2, $TaillePlasmide2, $Enzyme, $Site , $Frequence, $Positions);
 
 
 
 
=h
foreach my  $PlEnz (@Pl2)
{
        print Dumper ($PlEnz);
}
 
=cut
 
 
# Tableau récapitulatif
#-------------------------
 
print $Outfile "Comparaison des produits de digestion de 2 plasmides\n";
print $Outfile "-----------------------------------------------------\n\n\n";
print $Outfile "Taille du plasmide $Plasmide1\t$TaillePlasmide1\n";
print $Outfile "Taille du plasmide $Plasmide2\t$TaillePlasmide2\n\n\n";
 
print $Outfile "\n\nENZYMES COMMUNES AUX DEUX PLASMIDES\n";
print $Outfile "--------------------------------------\n\n";
 
print $Outfile "\n-------------------------------------------------------------------------\n\n";
print $Outfile   "---    Nom de l'enzyme de restriction                                 ---\n";
print $Outfile   "---                                                                   ---\n";
print $Outfile   "---    Plasmide 1 (coupé x fois) tailles des fragments obtenus        ---\n";
print $Outfile   "---    Plasmide 2 (coupé x fois) tailles des fragments obtenus        ---\n";
print $Outfile "\n-------------------------------------------------------------------------\n\n\n";
 
 
 
for (my $c =0; $c<$a; $c++)
{
        for (my $d = 0; $d<$b; $d++)
        {
                my ($Switch, $E1, $E2, $Ref_Tailles1, $Ref_Tailles2) = $Pl1[$c]->COMPARE($Pl2[$d]);
                if ($Switch == 1)
                {
                        print $Outfile $E1->{ENZYME}."\n";
                        print $Outfile "\n".$E1->{SEQUENCE}." (".$E1->{FREQUENCE}." fois)\t";
                        foreach my $T1 (@{$Ref_Tailles1})
                        {
                                print $Outfile "$T1\t";
                        }
                        print $Outfile "\n".$E2->{SEQUENCE}." (".$E2->{FREQUENCE}." fois)\t";
                        foreach my $T2 (@{$Ref_Tailles2})
                        {
                                print $Outfile "$T2\t";
                        }
                        print $Outfile "\n-------------------------------------------------------------------------\n"
                }
 
 
 
        }
}
 
 
# Recherche des enzymes ne coupant qu'un des deux plasmides et coupant plus d'une fois le second
#---------------------------------------------------------------------------------------------------
 
my @Enz_Communes = substract {$_->{ENZYME}} @Pl1, @Pl2;
 
print $Outfile "\n\nListe des enzymes communes\n";
print $Outfile "\n----------------------------\n\n";
foreach my $Enz (@Enz_Communes)
{
        print $Outfile $Enz." ";
}
 
 
=h
# ANCIEN CODE
 
# Recherche des enzymes ne coupant qu'un des deux plasmides et coupant plus d'une fois le second
#---------------------------------------------------------------------------------------------------
 
my @Enz_Communes;
for (my $c =0; $c<$a; $c++)
{
        for (my $d = 0; $d<$b; $d++)
        {
               if ($Pl1[$c]->{ENZYME} eq $Pl2[$d]->{ENZYME})
               {
                 push ( @Enz_Communes, $Pl1[$c]->{ENZYME});
               }
        }
}
 
print $Outfile "\n\nListe des enzymes communes\n";
print $Outfile "\n----------------------------\n\n";
foreach my $Enz (@Enz_Communes)
{
        print $Outfile $Enz." ";
}
=cut
 
print $Outfile "\n\nENZYMES NON COMMUNES\n";
print $Outfile "-----------------------\n\n";
print $Outfile "\nEnzymes ne coupant que $Plasmide1\n";
print $Outfile "----------------------------------\n\n";
for (my $c =0; $c<$a; $c++)
{
        my $OK = 0;
        foreach my $Enz(@Enz_Communes)
        {
                if ($Enz eq $Pl1[$c]->{ENZYME}){$OK = 1;}
        }
        if(($OK == 0) && ($Pl1[$c]->{FREQUENCE}>1))
        {
                print $Outfile "$Pl1[$c]->{ENZYME}\t$Pl1[$c]->{FREQUENCE} fois (positions : $Pl1[$c]->{POSITIONS})\n";
        }
 
}
print $Outfile "\nEnzymes ne coupant que $Plasmide2\n";
print $Outfile "----------------------------------\n\n";
for (my $d = 0; $d<$b; $d++)
{
        my $OK = 0;
        foreach my $Enz(@Enz_Communes)
        {
                if ($Enz eq $Pl2[$d]->{ENZYME}){$OK = 1;}
        }
        if(($OK == 0) && ($Pl2[$d]->{FREQUENCE}>1))
        {
                print $Outfile "$Pl2[$d]->{ENZYME}\t$Pl2[$d]->{FREQUENCE} fois (positions : $Pl2[$d]->{POSITIONS})\n";
        }
}
 
 
 
 
my $Fin = ctime();
print "\nTEMPS\n---------\nDépart\t=>".$Depart."\nFin\t=>".$Fin."\n";
 
close;
 
 
# renvoie la liste des éléments $code (->{ENZYME}) de l'array $b (\@Pl2) n'existant pas dans $a (\@Pl2)
sub substract (&\@\@)
{
    my ($code, $a, $b) = @_;
    my %temp;
    @temp{map {$code->()} @$b} = ();       # %temp contiendra les valeurs ENZYME de l'array b
    return grep { not exists $temp{$code->()} } @$a;
}

Merci,

Jasmine,

**Jedai** · 30/05/2007, 15h08

Accroche-toi, car cette fonction fait appel à quelques fonctionnalités avancées de Perl :

Code :

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

1
2
3
4
5
6
sub substract (&\@\@) {
    my ($code, $a, $b) = @_;
    my %temp;
    @temp{map {$code->()} @$b} = ();
    return grep { not exists $temp{$code->()} } @$a;
}

Tout d'abord le prototype : (&\@\@). Tu as peut-être remarqué qu'étrangement mon appel de fonction prenait des tableaux en paramètres, et ne les confondait pas par la suite bien que je n'ai pas utilisé de références ? C'est grâce aux \@\@ du prototype qui spécifie que je veux exactement deux tableaux en paramètre. Le & quant à lui me permet d'utiliser un bloc "nu" en premier argument de substract(), comme pour grep() ou map() ou sort(). Si je n'avais pas utilisé de prototype, mon appel aurait plutôt ressemblé à cela :

Code :

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

my @rest = substract(sub { $_->{ENZYME} }, \@Pl1, \@Pl2);

Mais le corps de la fonction n'aurait pas changé, le prototype ici est purement cosmétique, pour que ma fonction substract() ressemble plus à grep() puisqu'il y a une parenté dans la fonctionnalité.

Oublions donc un instant le prototype.

Code :

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

1
2
3
4
5
6
sub substract {
    my ($code, $a, $b) = @_;
    my %temp;
    @temp{map {$code->()} @$b} = ();
    return grep { not exists $temp{$code->()} } @$a;
}

substract() reçoit donc en paramètre une référence de fonction, et deux référence de tableau. On veut soustraire @$b à @$a en posant que deux éléments $elem1 et $elem2 sont égaux si et seulement si :

Code :

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

(do {$_ = $elem1; $code->()}) eq (do {$_ = $elem2; $code->()})

Autrement dit si $code->() renvoie la même chaîne de caractère pour les deux. ($code->() exécute la fonction référencée par $code).

Code :

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

@temp{map {$code->()} @$b} = ();

Est une manipulation sur %temp (et pas sur @temp), le @ n'est là que parce que ce que l'on manipule est une "tranche" (slice) de hash, c'est-à-dire un tableau de valeurs du hash.

Code :

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

my %hash; @hash{"hello", "good"} = ("world", "night");

Ce morceau de code remplit %hash avec deux paires clé-valeur, comme le code suivant :

Code :

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

my %hash = ( hello => "world", good => "night");

Dans notre cas, les valeurs n'ont pas vraiment d'importance (en fait comme j'ai mis () à droite du =, toutes les valeurs de %temp seront undef), par contre ce qui nous intéresse ce sont les clés.
Après cette manip, l'ensemble des clés de %temp est l'ensemble des "valeurs caractéristiques" de @$b. (cf "perldoc -f map" pour mieux comprendre comment ça fonctionne)

Code :

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

return grep { not exists $temp{$code->()} } @$a;

exists $hash{key} vérifie l'existence de la clé "key" dans le hash %hash. L'avantage c'est que cette vérification est en O(1) autrement dit en temps constant, quelle que soit la taille du hash.
Cette dernière ligne sélectionne donc les éléments de @$a qui ne sont pas aussi dans @$b. (cf "perldoc -f grep" si tu ne connais pas)

Voilà...
N'hésite pas à reposer quelques questions si tu n'as pas compris tous les détails.

--
Jedaï

comparaison de deux séries d'objets

Langage Perl

Vue hybride

Discussions similaires

Partager

Partager