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
|
sub optimiser_compilations {
# Cette routine constitue un algo de "seconde passe" de la répartition des emprises (la premiere passe etant &creer_compilations).
# Son but est d'améliorer la répartition par rapport au barrycentre de chaque groupe.
# Il faut recuperer compilations.tmp en placant les groupes créés dans
# %groupe{index}[index_dataset]{ligne_listing} = "index/str/ds;x y;taille"
# Calculer: barrycentres de chaque groupe dans
# %barrycentre{index_groupe} = 'x y'
my %groupe;
my $t = open(COMPILATIONS,"$config{dir_tmp}compilations.tmp");
my @compilations;
if ($t) {
@compilations=<COMPILATIONS>;
} # Fin if
else {
&afficher_erreur("\a\aERREUR dans le script: Impossible d'optimiser la repartition. Compilations.tmp illisible!\n");
} # Fin else
close COMPILATIONS;
# Récupération des groupes
my $nom_groupe='';
my $nb_elem=0;
foreach my $ligne (@compilations){ # Parcourt le listing généré par le premier algorithme
chomp $ligne;
if ($ligne =~ m/^INDEX=(.*)/) { # Nouveau groupe
$nom_groupe = $1;
} # Fin if
elsif ($ligne =~ m/^(\d+)\/(.+?)\/(\w+);(.+) (.+);(\d+)$/) {
push @{$groupe{$nom_groupe}}, $ligne;
$nb_elem++;
} # Fin elsif
} # Fin foreach
print "$nb_elem element a re-analyser!\n";
my %barrycentre;
#######################################################
# DEBUT DE L'ALGORITHME
#######################################################
print "Passe 2\n" if ($debug);
my $deplacements=0;
ALGO_PASSE2:
#### < Initialisation > #### Ici serait mon erreur ??
# Calcule du barrycentre de chaque groupe
%barrycentre=();
foreach my $groupe (keys %groupe) { # Parcourt chaque groupe récupéré
my ($somme_x, $somme_y, $nb_ds)=(0,0,0);
foreach my $ligne (@{$groupe{$groupe}}) {
if ($ligne =~ m/^(\d+)\/(.+?)\/(\w+);(.+) (.+);(\d+)$/) {
my $x = $4;
my $y = $5;
$somme_x+=$x;
$somme_y+=$y;
$nb_ds++;
} # Fin if
} # Fin foreach
if ($nb_ds>0) {
my $b_x = $somme_x/$nb_ds;
my $b_y = $somme_y/$nb_ds;
$barrycentre{$groupe} = "$b_x $b_y";
} # Fin if
} # Fin foreach
# Tri de @{$groupe{groupe}} par éloignement du centroide des datasets par rapport au barrycentre du groupe
# Afin d'avoir une liste du dataset le plus eloigné au dataset le plus rapproché du barrycentre de son groupe (le plus eloigné etant peut-etre un dataset à déplacer de CD).
foreach my $groupe (keys %groupe) {
my @liste = @{$groupe{$groupe}}; # On recupere la liste actuelle (non triée)
my $barrycentre = $barrycentre{$groupe};
my @liste_triee = &trier_datasets_par_eloignement($barrycentre, @liste);
my $i=-1;
foreach my $dataset (@liste_triee){ # Reaffectation ordonnancée des datasets dans %groupe
$i++; # Nom du groupe
$groupe{$groupe}[$i] = $dataset;
} # Fin foreach
} # Fin de foreach
#### < FIN Initialisation > ####
# Boucle generale sur chaque groupe (ordre quelconque)
foreach my $groupe (keys %groupe) {
foreach my $dataset (@{$groupe{$groupe}}) { # Parcourt les datasets, du plus eloigné du barrycentre au plus proche
next if ($dataset eq '');
if ($dataset =~ m/(.+);(.+) (.+);(\d+)/) { # On recup le centroide et la taille du dataset
my $id = $1;
my $c_x = $2; # X Centroide
my $c_y = $3; # Y Centroide
my $taille = $4;
my $point_centroide = [[$c_x],[$c_y]];
my ($b_x, $b_y) = split(/\s/,$barrycentre{$groupe}); # Barrycentre du groupe proprietaire
my $barrycentre_proprietaire = [[$b_x],[$b_y]];
my ($distance_proprietaire) = &distance_2_points($barrycentre_proprietaire, $point_centroide);
# On va parcourir tous les barrycentres des autres groupes et comparer leur distance au centroide par rapport à la distance du groupe proprietaire
my @groupes_candidats; # Contiendra les groupes plus proches
foreach my $groupe_barrycentre (keys %barrycentre){
next if ($groupe_barrycentre == $groupe); # Ignore le meme groupe!
my ($b2_x, $b2_y) = split(/\s/,$barrycentre{$groupe_barrycentre}); # Barrycentre du groupe testé
my $barrycentre_test= [[$b2_x],[$b2_y]];
my ($distance_test) = &distance_2_points($barrycentre_test, $point_centroide);
if ($distance_test < $distance_proprietaire){ # Groupe plus proche.... on l'ajoute à la liste candidate
push @groupes_candidats, "$distance_test, $groupe_barrycentre"; # Dist, ID du candidat
} # Fin if groupe plus proche
} # Fin foreach
# Il faut trier @groupes_candidats par distance croissante, puis prendre le premier groupe où il reste assez de place.
foreach my $candidat (sort {$a <=> $b} @groupes_candidats) { # On parcourt les candidats du plus proche au plus éloigné du dataset analysé
my($distance, $groupe_candidat)=split(/, /,$candidat);
# Reste-t-il de la place?
my $occupation_groupe = 0;
foreach my $element (@{$groupe{$groupe_candidat}}) { # On calcule le poids du groupe
if ($element =~ m/.+;.+ .+;(\d+)/) {
$occupation_groupe+=$1;
} # Fin if
else {
&afficher_erreur("\aERREUR DANS CE SCRIPT: Calcule du poids d'un groupe candidat impossible.\n") if (defined $element); # Condition necessaire car on supprime des elements qu'on deplace, et si on n'a pas reinitialisé l'algo! (normalement, on reinitialise...)
} # Fin else
} # Fin de foreach
$occupation_groupe/=1024;
$taille/=1024;
if ($config{capacite_media} - $occupation_groupe >= $taille) {
$deplacements++;
my $nouvelle_taille = $occupation_groupe+$taille;
print "DEPLACEMENT DE $id DANS LE GROUPE $groupe_candidat ($occupation_groupe Mo)!\n"; #Nouvelle taille: $nouvelle_taille Mo\n
# On effectue le deplacement:
push @{$groupe{$groupe_candidat}}, $dataset; # Copie
undef $dataset; # Supprime le dataset de son groupe originaire!
goto ALGO_PASSE2; # Reinitialisation de l'algorithme
last; # Sort de la boucle (on a le groupe le plus proche pouvant recevoir le dataset) -> si on ne reinitialise pas l'algo!
} # Fin if
} # Fin foreach candidat pesé
} # Fin if
else {
&afficher_erreur("\aERREUR: Un dataset n'a pu etre correctement traite:\n$dataset\n");
} # Fin else
} # Fin foreach
} # Fin de foreach
# TErminé
print "$deplacements elements deplaces par la seconde passe!\n";
# Autre bug: Si j'utilise ce bloc de code (auquel cas, je ne reinitialise pas l'algo apres chaque deplacement), j'obtiens une sortie tres similaire à 'lentree (se corrige puis se 'decourrige'....). Je ne comprend pas non plus. Mais c tjs lié à ma réinitialisation.
# if ($deplacements>0) {
# $deplacements=0;
# goto ALGO_PASSE2; # Reinitialisation de l'algorithme
# } # Fin if
if ($deplacements>0) {
# On ecrit le resultat:
my %liste_id; # Pour corriger un bug dans l'algorithme!
my $nb_elem=0;
my $t = open(COMPILATIONS, ">$config{dir_tmp}compilations.tmp");
if ($t) {
foreach my $groupe (sort {$a <=> $b} keys %groupe) {
print COMPILATIONS "\nINDEX=$groupe\n";
# Bug:
#$"="\n";
#my @liste = sort @{$groupe{$groupe}};
#print COMPILATIONS "@liste\n\n";
foreach my $element (@{$groupe{$groupe}}) {
if ($element=~m/^(.*)?;/) { # Id
if (! exists $liste_id{$1}){ # Pas deja ecrit!
$liste_id{$1}=1;
print COMPILATIONS "$element\n";
$nb_elem++;
} # Fin if
else {
print "Manifestation du bug des doublons de la passe 2\n";
} # Fin else
} # Fin if
} # Fin foreach
} # Fin foreach
} # Fin if
else {
&afficher_erreur("\aERREUR: Impossible de reecrire compilations.tmp a l'issue de la seconde passe!\n");
} # Fin else
close COMPILATIONS;
} # Fin if deplacements
print "$nb_elem datasets recompiles!\n";
} # Fin de sub |
Bug dans mon algo..
Répondre avec citation
umper). Ca met en evidence le probleme... mais ca ne m'a pas aidé à bien le localiser.
Partager