Discussion :

[cesium]

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 :

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
#!/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 !

[djibril]

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

[cesium]

bonne idée...
et voila :

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
#!/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

[Philou67430]

Code :

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

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 :

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

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 :

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

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.

[cesium]

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

je vais étudier ta réponse...

[cesium]

bonjour,

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

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
#!/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 :

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

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.

[Philou67430]

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

Code :

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

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

[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

[Philou67430]

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

[cesium]

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 :

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
#!/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

[Philou67430]

Tu peux effectivement tout regrouper :

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
#!/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).

[cesium]

merci pour tes corrections notamment sur les regexp dans @data
par contre ca ne fonctionne plus.
car la boucle foreach :

Code :

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

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é?

[Philou67430]

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

[cesium]

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 :

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
##!/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";
}

[Philou67430]

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 :

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
##!/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).

[Philou67430]

Pour remplacer le code d'affichage de %h à la fin, tu peux utiliser le module Data:umper:

Code :

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

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

[cesium]

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 :

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
%h = (
       'ROLE_B' => {},
       'ROLE_E' => {},
       'ROLE_C' => {},
       'USER_2' => {
                     'ROLE_E' => {
                                   'VA3' => [
                                              0,
                                              0
                                            ],
                                   'V02' => [
                                              0,
                                              0
                                            ],
                                   'FB1' => [
                                              0,
                                              '0',

[Philou67430]

C'est qu'il y a un bug... mais là, je n'ai plus le temps

[cesium]

merci philou,

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