compréhension de code (tableaux)

Version imprimable

Bonjour,

est ce que quelqu'un, plein de bonne volonté, pourrai m'expliquer ce code ?

le résultat convient presque à mes attentes mais je n'arrive pas à déchiffrer le code (surtout au niveau de la syntaxe des tableaux),
si je veux le façonner pour mon cas d'utilisation il faut que je le comprenne.
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 #!/usr/bin/perl use warnings; use strict; open(TCD,"tcd") || die ("Erreur d'ouverture de tcd"); my %h; my $l; my @col = 'A' .. 'D'; while(<TCD>){ next if /^$/; /(\w+)\s*(\w+)\s*(\w+)/; push @{$h{$3}{$1}},$2; for $l(@col){ push @{$h{$3}{$l}},0 unless exists $h{$3}{$l}; } } print "machine @col\n"; for my $k(keys %h){ print "$k"; for my $kk(sort keys %{$h{$k}}){ print " ",eval ( join "+",@{$h{$k}{$kk}}); } print "\n"; }
le fichier TCD :

A 20 machine1
B 5 machine1
A 5 machine2
C 10 machine2
A 50 machine1
A 20 machine1
B 5 machine1
A 5 machine2
C 10 machine2
D 50 machine1
D 20 machine1

le résultat :

machine A B C D
machine1 90 10 0 70
machine2 10 0 20 0

et l'autre question, a quel moment intervient l'addition (parce que je n'en veux pas)?

merci ! ;)

02/09/2010, 12h04
djibril

tu devrais déjà commenter le code pour nous montrer ce que tu comprends et ce que tu ne comprends pas ;)

bonne idée...
et voila :

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
#!/usr/bin/perl
 
use warnings;
use strict;
 
#ouverture du fichier TCD
open(TCD,"tcd") || die ("Erreur d'ouverture de TCD");
 
#déclaration table de hachage
my %h;
# déclaration variable scalaire
my $l;
#déclaration d'une liste de A jusqu'a D.
my @col = 'A' .. 'D';
 
#tant qu'il y a des ligne dans le fichier TCD
while(<TCD>){
  # cette ligne je ne comprends pas
  next if /^$/;
 
  # expression réguliere : mot espace mot espace mot   
  /(\w+)\s*(\w+)\s*(\w+)/;
 
  # cette ligne je ne comprends pas
  push @{$h{$3}{$1}},$2;
 
  # pour la ligne $l de mon tableau col (mais je ne suis pas sur de comprendre...)
  for $l(@col){
    # cette ligne je ne comprends pas :
    push @{$h{$3}{$l}},0 unless exists $h{$3}{$l};
  }
}
 
 
# affichage des entetes de mon tableau de résultat.
print "machine @col\n";
 
#tout le bloc suivant je ne comprends pas
for my $k(keys %h){
  print "$k";
  for my $kk(sort keys %{$h{$k}}){
    print " ",eval ( join "+",@{$h{$k}{$kk}});
  }
  print "\n";
}

merci

02/09/2010, 13h06
Philou67430
Code:

1 2 # cette ligne je ne comprends pas next if /^$/;
C'est une forme d'expression conditionnelle propre à Perl : l'instruction next est executée si /^$/ est vrai.

L'expression /^$/ est une expression booléenne correspondant à la recherche de motif (regexp) dans la variable $_ (variable implicite mise à jour dans le while(<FIC>) par le contenu de chaque ligne).
L'expression régulière (le motif) spécifie qu'il ne doit y avoir aucun caractère entre le début et la fin de la ligne (soit une ligne vide).
Donc, on saute les lignes vides avec next if /^$/
Code:

1 2 # cette ligne je ne comprends pas push @{$h{$3}{$1}},$2;
La fonction push opère sur un tableau en ajoutant un ou plusieurs éléments à la fin du tableau.
Le tableau concerné est @{$h{$3}{$1}} et l'élément ajouté est $2 ($1, $2, $3 sont des variables automatiques mise à jour par l'expression régulière exécutée juste avant).
Le tableau en question est stocké dans une variable de type hashage qu'on pourrait apparenté à une structure dans les autres langages.
%h est donc un hash dont une des clés est $3.
Le contenu de $h{$3} est lui-même également un hash (plus précisément une référence à un hash) et l'une des clés de ce 2e hash doit être $1. Une notation plus adaptée aurait été : $h{$3}->{$1}.
Le contenu de $h{$3}{1} est lui même un tableau (plus précisément une référence à un tableau). On le déréférence pour obtenir le tableau à fournir à push en le préfixant de @ (et en précisant la portée avec les accolades) : @{$h{$3}{$1}}
Code:

1 2 # cette ligne je ne comprends pas : push @{$h{$3}{$l}},0 unless exists $h{$3}{$l};
Avec les explications des deux premières lignes, tu devrais comprendre celle-ci, qui condense les deux écritures : push dans un tableau selon une condition (unless === if not).

Précision : la fonction exists permet de vérifier l'existence d'une clé dans un hash.
02/09/2010, 15h04
cesium

wahou
merci,
ca me rassure je n'aurais pas trouvé tout seul.

je vais étudier ta réponse...

bonjour,

grâce à votre aide, j'ai compris dans l'ensemble le code, je suis arrivé a l'adapter à mes données.

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
#!/usr/bin/perl
use strict;use warnings;
 
my %h;
 
while(<DATA>){
  /(\w+)\s*(\w+)\s*(\w+)/;
  push @{$h{$1}{$2}},$3;
 
  push @{$h{$1}{'ZTA'}},0 unless exists $h{$1}{'ZTA'};
  push @{$h{$1}{'VP3'}},0 unless exists $h{$1}{'VP3'};
  push @{$h{$1}{'V23'}},0 unless exists $h{$1}{'V23'};
  push @{$h{$1}{'VA3'}},0 unless exists $h{$1}{'VA3'};
  push @{$h{$1}{'V02'}},0 unless exists $h{$1}{'V02'};
  push @{$h{$1}{'VA5'}},0 unless exists $h{$1}{'VA5'};
}
 
print "tc V02 V23 VA3 VA5 VP3 ZTA\n";
for my $k(keys %h){
 
  print "$k";
  for my $kk(sort keys %{$h{$k}}){
  print " ",eval ( join "+",@{$h{$k}{$kk}});
  }
print "\n";
}
__END__
ROLE_B VA3 1
ROLE_A V23 0
ROLE_A ZTA 1
ROLE_A VP3 1
ROLE_C VA5 0
ROLE_C V23 1
ROLE_B V23 1
ROLE_B V02 1

quelqu'un peut t'il m'aider pour remplacer le bout de code suivant par une boucle car mes valeurs ZTA, VP3... peuvent varier:

Code:

1
2
3
4
5
6
7
 
  push @{$h{$1}{'ZTA'}},0 unless exists $h{$1}{'ZTA'};
  push @{$h{$1}{'VP3'}},0 unless exists $h{$1}{'VP3'};
  push @{$h{$1}{'V23'}},0 unless exists $h{$1}{'V23'};
  push @{$h{$1}{'VA3'}},0 unless exists $h{$1}{'VA3'};
  push @{$h{$1}{'V02'}},0 unless exists $h{$1}{'V02'};
  push @{$h{$1}{'VA5'}},0 unless exists $h{$1}{'VA5'};

merci pour votre aide.

Je n'ai pas bien compris la question. Je tente quelque chose :
Code:

1 2 3 foreach $truc (qw(ZTA VP3 V23 VA3 V02 VA5)) { push @{$h{$1}{$truc}},0 unless exists $h{$1}{$truc}; }

08/09/2010, 18h23
cesium

merci,

en effet ca fonctionne, mais mes valeurs ZTA VP3 V23 VA3 V02 VA5 ne sont pas des valeurs fixes, en sachant aussi que dans ce cas il y a 6 valeurs mais c'est un nombre qui peut varier

exemple d'un autre jeu de données:

RÔLE_D LL3 1
RÔLE_D FB3 0
RÔLE_E FB3 1
RÔLE_E FB1 0
08/09/2010, 21h30
Philou67430

Il vous suffit de remplacer la liste qw(ZTA VP3 V23 VA3 V02 VA5) par un tableau contenant vos paramètres.

merci philou.

ca fonctionne désormais.
par contre je ne sais pas si le code est bien optimisé (je suis obligé d'ouvrir 2 fois le fichier pour remplir 2 tableaux differents):

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
#!/usr/bin/perl
use strict;use warnings;
 
my %h;
my @tab_unique_tc = ();
my @tabtc = ();
 
open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique");
 
while(<TCD>){
  next if /^$/;
  /(\w+)\s*(\w+)\s*(\w+)\s*(\w+)/;
 
  push (@tabtc,$3);
  # effacer les doublons
  my %h_tc   = map { $_, 1 } @tabtc;
  @tab_unique_tc = sort keys %h_tc;
 
}
 
close (TCD);
open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique");
 
while(<TCD>){
  next if /^$/;
  /(\w+)\s*(\w+)\s*(\w+)\s*(\w+)/;
  push @{$h{$2}{$3}},$4;
 
  foreach my $tc (@tab_unique_tc) {
    push @{$h{$2}{$tc}},0 unless exists $h{$2}{$tc};
  }
}
 
print "tc : @tab_unique_tc \n";
 
for my $k(keys %h){
  print "$k";
  for my $kk(sort keys %{$h{$k}}){
  print " ",eval ( join "+",@{$h{$k}{$kk}});
  }
print "\n";
}

et le fichier TCD :

USER_1 ROLE_B VA3 1
USER_1 ROLE_A V23 0
USER_1 ROLE_A ZTA 1
USER_1 ROLE_A VP3 1
USER_1 ROLE_C VA5 0
USER_1 ROLE_C V23 1
USER_1 ROLE_B V23 1
USER_1 ROLE_B V02 1

Tu peux effectivement tout regrouper :

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
#!/usr/bin/perl
use strict;
use warnings;
 
my %h;
my @tab_unique_tc = ();
my @tabtc = ();
 
open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique");
 
while(<TCD>){
  next if /^$/;
  if (my @data = /(\w+)\s*(\w+)\s*(\w+)\s*(\w+)/) {
 
    push (@tabtc,$data[2]);
    # effacer les doublons
    my %h_tc   = map { $_, 1 } @tabtc;
    @tab_unique_tc = sort keys %h_tc;
 
    push @{$h{$data[1]}{$data[2]}},$data[3];
 
    foreach my $tc (@tab_unique_tc) {
      push @{$h{$data[1]}{$tc}},0 unless exists $h{$data[2]}{$tc};
    }
  }
}
close TCD;
 
print "tc : @tab_unique_tc \n";
 
for my $k(keys %h){
  print "$k";
  for my $kk(sort keys %{$h{$k}}){
  print " ",eval ( join "+",@{$h{$k}{$kk}});
  }
print "\n";
}

J'ai également utilisé une variable @data pour stocker les informations capturée dans la regexp, car il n'est pas sain d'utiliser les variables automatiques $1, $2, ... à cause de leur effet de bord (l'usage d'une nouvelle regexp pendant le traitement des données qu'elles contiennent les re-initialiseraient).

09/09/2010, 11h18
cesium
merci pour tes corrections notamment sur les regexp dans @data
par contre ca ne fonctionne plus.
car la boucle foreach :
Code:

1 2 3 foreach my $tc (@tab_unique_tc) { push @{$h{$data[1]}{$tc}},0 unless exists $h{$data[1]}{$tc}; }
attends un tableau (@tab_unique_tc) complet alors que dans ce cas il est rempli au fur et a mesure de la boucle while.

c'est pour cela que j'avais mis 2 boucles séparés. y a t'il une solution plus adapté?
09/09/2010, 12h03
Philou67430

Oups... désolé, je n'ai pas fait attention. Les deux boucles me semblent donc incontournables.

non il n'y a pas de souci, avec toute l'aide que tu me fournis je ne vais pas me plaindre en plus...je ne peux que te remercier.

d'ailleurs voici l'un de mes derniers problème,

mon fichier d'entrée à évolué et il faut que je boucle sur un champs de plus, voici mon fichier TCD :

USER_2 ROLE_D LL3 1
USER_2 ROLE_D FB3 0
USER_2 ROLE_E FB3 1
USER_2 ROLE_E FB1 0
USER_2 ROLE_A ZTA 1
USER_1 ROLE_A ZTA 0
USER_1 ROLE_A VP3 0
USER_1 ROLE_B V23 1
USER_1 ROLE_B VA3 0
USER_1 ROLE_B V02 0
USER_1 ROLE_C VA5 1
USER_1 ROLE_C V23 1

sachant que j'ai plus de 2 users...

je souhaite avoir un résultat comme l'actuel mais pour chaque utilisateur.

si je rajoute une boucle générale, mes 2 boucles while sur le fichier TCD vont désynchroniser mon incrément sur l'utilisateur.

je pense devoir gérer ca dans des tableaux mais mes compétences me bloquent.

un peu d'aide serai la bienvenue.

mon code actuel :
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 ##!/usr/bin/perl use strict; use warnings; my %h; my @tab_unique_tc = (); my @tabtc = (); open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique"); while(<TCD>){ next if /^$/; if (my @data_tc = /(\w+)\s*(\w+)\s*(\w+)\s*(\w+)/){ push (@tabtc,$data_tc[2]); # effacer les doublons my %h_tc = map { $_, 1 } @tabtc; @tab_unique_tc = sort keys %h_tc; } } close TCD; open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique"); while(<TCD>){ next if /^$/; if (my @data = /(\w+)\s*(\w+)\s*(\w+)\s*(\w+)/) { push @{$h{$data[1]}->{$data[2]}},$data[3]; foreach my $tc (@tab_unique_tc) { push @{$h{$data[1]}{$tc}},0 unless exists $h{$data[1]}{$tc}; } } } close TCD; print "tc : @tab_unique_tc \n"; for my $k(keys %h){ print "$k"; for my $kk(sort keys %{$h{$k}}){ print " ",eval ( join "+",@{$h{$k}{$kk}}); } print "\n"; }

Je suppose que ton résultat est le hash %h ?
Je suppose que tu veux ajouter un niveau dans l'arborescence de %h qui est basé sur le user.
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 ##!/usr/bin/perl use strict; use warnings; my %h; my @tab_unique_tc = (); my @tabtc = (); open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique"); while(<TCD>){ next if /^$/; my @data_tc = split /\s+/; push (@tabtc,$data_tc[2]); # effacer les doublons } close TCD; my %h_tc = map { $_, 1 } @tabtc; @tab_unique_tc = sort keys %h_tc; open(TCD,"tcd") || die ("Erreur d'ouverture de tableau croisé dynamique"); while(<TCD>){ next if /^$/; my @data = split /\s+/; push @{$h{$data[0]}->{$data[1]}->{$data[2]}}, $data[3]; foreach my $tc (@tab_unique_tc) { push @{$h{$data[0]}->{$data[1]}{$tc}},0 unless exists $h{$data[1]}{$tc}; } } close TCD; print "tc : @tab_unique_tc \n"; for my $user (keys %h) { for my $k(keys %{$h{$user}}){ print "$k"; for my $kk(sort keys %{$h{$user}->{$k}}){ print " ",eval ( join "+",@{$h{$user}->{$k}{$kk}}); } } print "\n"; }
J'ai réalisé une autre modif dans ton code initiale : j'ai remplacé la recherche de regexp par un split, plus simple.
J'ai également extrait de la boucle while la recherche d'unicité des tc. Elle peut se faire une fois la table @data_tc remplie.
Je ne suis pas sur du bon affichage de la table à la fin.

Attention : ce script utilise massivement l'auto-vivification (perldoc perlref et chercher vivification).

09/09/2010, 16h24
Philou67430
Pour remplacer le code d'affichage de %h à la fin, tu peux utiliser le module Data::Dumper:
Code:

1 2 3 4 use Data::Dumper; ... print Data::Dumper->Dump([\%h], [qw(*h)]);

encore merci philou
c'est top ce module car ca donne une belle vision graphique.

par contre je n'arrive pas a voir d'ou viennent certaines clés de %h
car pour moi ces clés qui sont "en haut de la hierarchie" ne doivent contenir que les users (USER_1, USER_2...) mais elles contiennent aussi les roles sans autre hiérarchie en dessous.

et voici l'exemple du début de résultat avec le module data dumper :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
%h = (
       'ROLE_B' => {},
       'ROLE_E' => {},
       'ROLE_C' => {},
       'USER_2' => {
                     'ROLE_E' => {
                                   'VA3' => [
                                              0,
                                              0
                                            ],
                                   'V02' => [
                                              0,
                                              0
                                            ],
                                   'FB1' => [
                                              0,
                                              '0',

09/09/2010, 18h25
Philou67430

C'est qu'il y a un bug... mais là, je n'ai plus le temps :oops:
14/09/2010, 10h05
cesium

merci philou,

j'ouvre un nouveau post pour mon probleme car la je me suis bien ecarté du sujet.