line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Optimization::NSGAII; |
2
|
|
|
|
|
|
|
|
3
|
12
|
|
|
12
|
|
802608
|
use 5.006; |
|
12
|
|
|
|
|
48
|
|
4
|
12
|
|
|
12
|
|
48
|
use warnings; |
|
12
|
|
|
|
|
12
|
|
|
12
|
|
|
|
|
228
|
|
5
|
12
|
|
|
12
|
|
48
|
use strict; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
372
|
|
6
|
|
|
|
|
|
|
|
7
|
12
|
|
|
12
|
|
60
|
use feature 'say'; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
1248
|
|
8
|
12
|
|
|
12
|
|
60
|
use Exporter; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
540
|
|
9
|
|
|
|
|
|
|
our @ISA = ("Exporter"); |
10
|
12
|
|
|
12
|
|
5520
|
use Data::Dumper; |
|
12
|
|
|
|
|
60216
|
|
|
12
|
|
|
|
|
576
|
|
11
|
12
|
|
|
12
|
|
60
|
use List::Util qw/min max/; |
|
12
|
|
|
|
|
24
|
|
|
12
|
|
|
|
|
1056
|
|
12
|
12
|
|
|
12
|
|
60
|
use Carp; |
|
12
|
|
|
|
|
12
|
|
|
12
|
|
|
|
|
42444
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=pod |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Optimization::NSGAII - non dominant sorting genetic algorithm for multi-objective optimization |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 VERSION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Version 0.01 |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=cut |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = "0.01"; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SYNOPSIS |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use Optimization::NSGAII qw/ f_Optim_NSGAII /; |
31
|
|
|
|
|
|
|
use Data::Dumper; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# D E F I N E O B J E C T I V E S T O O P T I M I Z E |
34
|
|
|
|
|
|
|
########################################################### |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub f_to_optimize { |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $x = shift; # load input parameters (genes constituting a single individual) |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# ... # do your things using these inputs $x->[0], $x->[1] ... |
41
|
|
|
|
|
|
|
# and produce the outputs to be minimized $f1, $f2 ... |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# examples of things you can do include: |
44
|
|
|
|
|
|
|
# - mathematical formulas in perl to define $f1, $f2, ... |
45
|
|
|
|
|
|
|
# - computations with commercial software and so: |
46
|
|
|
|
|
|
|
# - write input file using $x->[0] ... |
47
|
|
|
|
|
|
|
# - run the computation, for example with perl system() function |
48
|
|
|
|
|
|
|
# - locally or |
49
|
|
|
|
|
|
|
# - on a server for example with 'qsub... ' |
50
|
|
|
|
|
|
|
# - wait simulation to end |
51
|
|
|
|
|
|
|
# - postprocess its output and define $f1, $f2 ... |
52
|
|
|
|
|
|
|
# - ... |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my $out = [$f1,$f2,$f3]; # and finally return the set of these outputs for |
55
|
|
|
|
|
|
|
return $out; # this single individual of the population |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# D E F I N E B O U N D S [ A N D I N E Q U A L I T I E S ] |
60
|
|
|
|
|
|
|
################################################################### |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# define min and max bounds for $x->[0], $x->[1], ... |
63
|
|
|
|
|
|
|
my $bounds = [[0,1],[0,1],[0,1]]; # example with 3 input parameters (genes) with min = 0 and max = 1: |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub f_inequality { # optional inequality constraints set |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $x =shift; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
my @ineq = |
70
|
|
|
|
|
|
|
( |
71
|
|
|
|
|
|
|
$x->[1] + 1 , # equations >= 0 |
72
|
|
|
|
|
|
|
$x->[0] + $x->[1] - 9, |
73
|
|
|
|
|
|
|
... |
74
|
|
|
|
|
|
|
... |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
return \@ineq; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# R U N O P T I M I Z A T I O N |
82
|
|
|
|
|
|
|
################################# |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# execute NSGA-II algorithm |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
my $ref_input_output = f_Optim_NSGAII( |
87
|
|
|
|
|
|
|
{ |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
'nPop' => 50, # population size |
90
|
|
|
|
|
|
|
'nGen' => 250, # final generation number |
91
|
|
|
|
|
|
|
'bounds' => $bounds, # loads the previously defined bounds |
92
|
|
|
|
|
|
|
'function' => \&f_to_optimize, # loads the subroutine to optimize (minimize) |
93
|
|
|
|
|
|
|
'nProc' => 8, # how many individuals to evaluate in parallel as separate processes |
94
|
|
|
|
|
|
|
'filesDir' => '/tmp', # work directory |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
# optional parameters: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
'verboseFinal' => 1, # 0|1: input and output values print at final generation, for each individual of the population |
100
|
|
|
|
|
|
|
# default: print is made ( = 1) |
101
|
|
|
|
|
|
|
'f_ineq' => \&f_inequality, # subroutine describing the constraining inequality set |
102
|
|
|
|
|
|
|
# default: no constraint function |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# parameters for mutation |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
'distrib' => [-1,0,1], # distribution of values (for example a Gaussian distribution), used to perturb individuals |
107
|
|
|
|
|
|
|
# default: [-1,-0.5,0,0.5,1] |
108
|
|
|
|
|
|
|
'scaleDistrib' => 0.05, # scaling of the distribution array |
109
|
|
|
|
|
|
|
# default: 0 (no perturbation will be done) |
110
|
|
|
|
|
|
|
'percentMut' => 5, # percentage of individual that are randomly perturbated (in all their genes) |
111
|
|
|
|
|
|
|
# and also percentage of input parameters (genes) that are randomly mutated in each individual |
112
|
|
|
|
|
|
|
# default: 5% |
113
|
|
|
|
|
|
|
}, |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# the following is the optional set of parameters for 'Pareto front' 2D live plot |
116
|
|
|
|
|
|
|
# if the part below is not present, no plot will be made |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
{ |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
'dx' => 200, # characters width and height of the plot |
121
|
|
|
|
|
|
|
'dy' => 40, |
122
|
|
|
|
|
|
|
'xlabel' => 'stiffness [N/mm]', # horizontal and vertical axis labels |
123
|
|
|
|
|
|
|
'ylabel' => 'mass [kg]', |
124
|
|
|
|
|
|
|
'xlim' => [0,1], # horizontal and vertical axis limits |
125
|
|
|
|
|
|
|
'ylim' => [0,1], |
126
|
|
|
|
|
|
|
'nfun' => [0,2], # which function to plot from return value by f_to_optimize ($out) ; 0=f1, 1=f2 ... |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
); |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# U S E S O L U T I O N S |
131
|
|
|
|
|
|
|
############################ |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# for example print of the input parameters and |
134
|
|
|
|
|
|
|
# corresponding output functions' values of the final found Pareto front |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
my @ref_input = @{$ref_input_output->[0]}; |
137
|
|
|
|
|
|
|
my @ref_output = @{$ref_input_output->[1]}; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
print Dumper(\@ref_input); |
140
|
|
|
|
|
|
|
print Dumper(\@ref_output); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head1 EXPORT |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=over |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=item * f_Optim_NSGAII |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=back |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
our @EXPORT_OK = qw/ f_Optim_NSGAII /; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=head1 DESCRIPTION |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 Reference |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
NSGAII.pm apply (with some variations) the NSGA-II algorithm described in the paper: |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
A Fast and Elitist Multiobjective Genetic Algorithm:NSGA-II |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=over |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Kalyanmoy Deb, Associate Member, IEEE, Amrit Pratap, Sameer Agarwal, and T. Meyarivan |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=back |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head2 Objective |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
C performs multi-objective optimization using a genetic algorithm approach: it searches the input parameters (genes) which minimize a set of output functions and with some luck a Pareto front is produced. |
176
|
|
|
|
|
|
|
In the Pareto front no solution is better than the others because each solution is a trade-off. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head2 Function to optimize |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
This module requires to define a perl subroutine (C in the code above) which can take the input parameters and gives the corresponding outputs (in other words, it requires a subroutine to evaluate an individual of this population) |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head2 Features |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
The optimization is done: |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=over 3 |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=item * considering allowed B |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=item * considering optional B (x1^2 + sqrt(x2) -x3 >= 0 , ...) |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=item * with a B of the subroutine to optimize (and so of individuals) in each generation, by using perl fork() function |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=back |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
The inequalities must be given by a subroutine which calculate the error, look below in the example: basically all the LHS of the inequalities in the form "... >=0" are put in an array. |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
The number of B of C, and so the value of C, can be for example the max number of parallel C computation that you want and can: |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=over |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=item * run on your pc if you run the computation locally (e.g. 4) |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=item * run on a remote server if you run (inside the C) the computation there (e.g. 256) |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=back |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
C should be multiple of C, to optimize resources use, but it is not necessary. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
Problems with this modules are expected on systems not supporting fork() perl function. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
A B<2D plot> can be activated to control in real time the convergence of the algorithm on two chosen output functions (to assist at the formation of the Pareto front, generation after generation). |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Each time a new generation finish, all information of the population are written in the C directory: |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=over |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item * VPt_genXXXXX.txt: input (parameters values) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=item * Pt_genXXXXX.txt: output (corresponding functions values) |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=back |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head2 Mutation |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
The implementation of the B part has been done in a B. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
In particular B are applied in sequence: |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=over |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item 1) mutation of all the input parameters (the genes), but only on a certain percentage C of the population: |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
-> Small perturbation of the each gene by adding a number chosen randomly from the given C (scaled with both C and the difference between the two bounds). |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=item 2) mutation of all the individuals of the population, but only on a certain percentage C of the input parameters (the genes) |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
-> Random change (inside the permitted bounds) |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=back |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 Verification |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
This module has been tested, successfully, on many of the test problems defined in the paper described in the Reference section (see EXAMPLE section) |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
The performance (convergence for same population number and max generation number) seems to be comparable to that described in that paper. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 EXAMPLE |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
B (the same test problems contained in the paper described in the Reference section) are available in the test folder (F containing ZDT1, ZDT2, TNK, ...). |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Here you see the B problem with: |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=over |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item * two input parameters $x->[0] and $x->[1] |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item * two output functions to optimize f1 and f2 |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=item * two constraining equations between the input parameters |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=item * 8 process in parallel (8 subroutine f_CONTRS are evaluated in parallel as indipendent processes) |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=back |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
use Optimization::NSGAII qw/ f_Optim_NSGAII /; |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# function to minimize |
276
|
|
|
|
|
|
|
sub f_CONSTR { |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
my $x = shift; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
my $n = scalar(@$x); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $f1 = $x->[0]; |
283
|
|
|
|
|
|
|
my $f2 = (1 + $x->[1])/$x->[0]; |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
my $out = [$f1,$f2]; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
return $out; |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
# inequality constraints set |
291
|
|
|
|
|
|
|
sub f_inequality { |
292
|
|
|
|
|
|
|
my $x =shift; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# equation >= 0 |
295
|
|
|
|
|
|
|
my @ineq = |
296
|
|
|
|
|
|
|
( |
297
|
|
|
|
|
|
|
$x->[1] + 9*$x->[0] - 6 , |
298
|
|
|
|
|
|
|
-$x->[1] + 9*$x->[0] -1 |
299
|
|
|
|
|
|
|
); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
return \@ineq; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my $bounds = [[0.1,1],[0,5]]; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
my $ref_input_output = f_Optim_NSGAII( |
307
|
|
|
|
|
|
|
{ |
308
|
|
|
|
|
|
|
'nPop' => 50, |
309
|
|
|
|
|
|
|
'nGen' => 100, |
310
|
|
|
|
|
|
|
'bounds' => $bounds, |
311
|
|
|
|
|
|
|
'function' => \&f_CONSTR, |
312
|
|
|
|
|
|
|
'f_ineq' => \&f_inequality, |
313
|
|
|
|
|
|
|
'nProc' => 8, |
314
|
|
|
|
|
|
|
'filesDir' => '/tmp', |
315
|
|
|
|
|
|
|
'verboseFinal' => 1, |
316
|
|
|
|
|
|
|
'distrib' => [-1,-0.9,-0.8,-0.7,-0.6,-0.5,-0.4,-0.3,-0.2,-0.1,0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9], |
317
|
|
|
|
|
|
|
'scaleDistrib' => 0.05, |
318
|
|
|
|
|
|
|
'percentMut' => 5, |
319
|
|
|
|
|
|
|
}, |
320
|
|
|
|
|
|
|
{ |
321
|
|
|
|
|
|
|
'dx' => 100, |
322
|
|
|
|
|
|
|
'dy' => 40, |
323
|
|
|
|
|
|
|
'xlabel' => 'stiffness [N/mm]', |
324
|
|
|
|
|
|
|
'ylabel' => 'mass [kg]', |
325
|
|
|
|
|
|
|
'xlim' => [0.1,1], |
326
|
|
|
|
|
|
|
'ylim' => [0,10], |
327
|
|
|
|
|
|
|
'nfun' => [0,1], |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=head1 OUTPUT PREVIEW |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
This below is a typical output of the final Pareto front (problem TNK). |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
The numbers represent the rank of the points: in the initial generations you can see points of rank 1,2,3... where points with rank 1 dominate points of rank 2 and so on. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
Generation after generation all the points go on the Pareto front, so all the points become rank 1 (not dominated, nothing best is present in this population) |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
The points will also expand to occupy the entire front. |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
GENERATION 250 |
345
|
|
|
|
|
|
|
m| |
346
|
|
|
|
|
|
|
a| |
347
|
|
|
|
|
|
|
s| |
348
|
|
|
|
|
|
|
s| |
349
|
|
|
|
|
|
|
| |
350
|
|
|
|
|
|
|
[| |
351
|
|
|
|
|
|
|
k| |
352
|
|
|
|
|
|
|
g| 1 |
353
|
|
|
|
|
|
|
]| 11 |
354
|
|
|
|
|
|
|
| 11 |
355
|
|
|
|
|
|
|
| 1 1 |
356
|
|
|
|
|
|
|
| 11 |
357
|
|
|
|
|
|
|
| 1 |
358
|
|
|
|
|
|
|
| 11 1 1 1 1 |
359
|
|
|
|
|
|
|
| 1 |
360
|
|
|
|
|
|
|
| 1 |
361
|
|
|
|
|
|
|
| |
362
|
|
|
|
|
|
|
| 1 |
363
|
|
|
|
|
|
|
| 1 1 |
364
|
|
|
|
|
|
|
| 1111 |
365
|
|
|
|
|
|
|
| 1 |
366
|
|
|
|
|
|
|
| |
367
|
|
|
|
|
|
|
| |
368
|
|
|
|
|
|
|
| |
369
|
|
|
|
|
|
|
| |
370
|
|
|
|
|
|
|
| 1 |
371
|
|
|
|
|
|
|
| 11 |
372
|
|
|
|
|
|
|
| 1 |
373
|
|
|
|
|
|
|
| 1 |
374
|
|
|
|
|
|
|
| |
375
|
|
|
|
|
|
|
|______________________________________________________________________ |
376
|
|
|
|
|
|
|
stiffness [N/mm] |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head1 INSTALLATION |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
execute: |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
C |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
or (following the instruction in perlmodinstall) |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
=over |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=item * download the F |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
=item * decompress and unpack |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=over |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=item * C |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=item * C |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=back |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
=item * C |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item * C |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=item * C |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
=item * C |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
=item * C |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
to install it locally use this instead of C: |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
C if you want to install it in /my/folder |
416
|
|
|
|
|
|
|
then you will have to use in your script: C |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=back |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=head1 AUTHOR |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
Dario Rubino, C<< >> |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head1 BUGS |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Solutions (input-output pairs) often contain duplicates, this would require some investigation. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Please report any bugs to C, or through |
436
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
437
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head1 SUPPORT |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
perldoc Optimization::NSGAII |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
You can also look for information at: |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=over 4 |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
L |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=item * CPAN Ratings |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
L |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=item * Search CPAN |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
L |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=back |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
This software is Copyright (c) 2022 by Dario Rubino. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
This is free software, licensed under: |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
The Artistic License 2.0 (GPL Compatible) |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=cut |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# A point in the population is defined by: |
478
|
|
|
|
|
|
|
# - input values for the objective functions (input parameters) -> contained in the reference VP |
479
|
|
|
|
|
|
|
# - correspondent output population (objective function values) -> contained in the reference P |
480
|
|
|
|
|
|
|
# |
481
|
|
|
|
|
|
|
# P is the most important set of values used in this package, because the objective functions' values lead the algorithm |
482
|
|
|
|
|
|
|
# VP elements then are postprocessed accordingly so that P and VP maintain always a one to one index correspondence |
483
|
|
|
|
|
|
|
# |
484
|
|
|
|
|
|
|
# VARIABLES |
485
|
|
|
|
|
|
|
# |
486
|
|
|
|
|
|
|
# VP: input values for each population's point |
487
|
|
|
|
|
|
|
# : [[x11,x12,...x1D],...] |
488
|
|
|
|
|
|
|
# P : population (objective values for each point) |
489
|
|
|
|
|
|
|
# : [[fun11,fun12,..fun1M],..] |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# D : number of dimension of the problem (how many input values for a point) |
492
|
|
|
|
|
|
|
# N : size of population P |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
# p,q : index of a single solution of the population |
495
|
|
|
|
|
|
|
# : id_sol_ith |
496
|
|
|
|
|
|
|
# Sp: set of solution dominated by p (worse than p) for each point |
497
|
|
|
|
|
|
|
# : [[id_sol_i,id_sol_j,...],..] |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# np: number of solutions which dominate p (better than p), np = zero for first front solutions |
500
|
|
|
|
|
|
|
# : [np1,np2,..] |
501
|
|
|
|
|
|
|
# F: set of solution in front ith |
502
|
|
|
|
|
|
|
# : [[id_sol_k,id_sol_t,...],...] |
503
|
|
|
|
|
|
|
# rank : rank of each solution = front number , rank = 1 for first front solutions |
504
|
|
|
|
|
|
|
# : [rank1,rank2...rankN]; |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
######################################################################################################## |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my @out_print; |
509
|
|
|
|
|
|
|
my $inf = 1e9; |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub f_ineq2maxerr { |
512
|
|
|
|
|
|
|
# max error calculation in inequalities |
513
|
|
|
|
|
|
|
# input: lhs inequalities ref (errors) |
514
|
|
|
|
|
|
|
# output: max error |
515
|
2359786
|
|
|
2359786
|
0
|
2544755
|
my $ref_ineq = shift; |
516
|
|
|
|
|
|
|
|
517
|
2359786
|
|
|
|
|
2339026
|
my @ineq = @{$ref_ineq}; |
|
2359786
|
|
|
|
|
2983545
|
|
518
|
|
|
|
|
|
|
|
519
|
2359786
|
|
|
|
|
2533949
|
my $err = 0; |
520
|
2359786
|
|
|
|
|
2649070
|
foreach my $el(@ineq){ |
521
|
2359786
|
|
|
|
|
3595654
|
$err = max( $err, -$el); |
522
|
|
|
|
|
|
|
} |
523
|
2359786
|
|
|
|
|
3106441
|
return $err; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub f_fast_non_dominated_sort { |
528
|
|
|
|
|
|
|
# reference to population |
529
|
66
|
|
|
66
|
0
|
181
|
my $P = shift; |
530
|
66
|
|
|
|
|
119
|
my $VP = shift; |
531
|
66
|
|
|
|
|
117
|
my $f_ineq = shift; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
|
534
|
66
|
|
|
|
|
333
|
my $Sp; |
535
|
|
|
|
|
|
|
my $np; |
536
|
66
|
|
|
|
|
0
|
my $F; |
537
|
66
|
|
|
|
|
0
|
my $rank; |
538
|
|
|
|
|
|
|
|
539
|
66
|
|
|
|
|
90
|
my $N = scalar(@{$P}); |
|
66
|
|
|
|
|
189
|
|
540
|
|
|
|
|
|
|
|
541
|
66
|
|
|
|
|
495
|
foreach my $p(0..$N-1){ |
542
|
6600
|
|
|
|
|
9798
|
$np->[$p] = 0; |
543
|
6600
|
|
|
|
|
9693
|
foreach my $q(0..$N-1){ |
544
|
660000
|
100
|
|
|
|
896910
|
next if $p == $q; # max error <-- inequalities <-- input pars |
545
|
653400
|
100
|
|
|
|
775025
|
if ( f_dominates($P->[$p],$P->[$q], f_ineq2maxerr( &{$f_ineq}($VP->[$p]) ), f_ineq2maxerr( &{$f_ineq}($VP->[$q])) ) ){ |
|
653400
|
100
|
|
|
|
777092
|
|
|
653400
|
|
|
|
|
827219
|
|
546
|
126907
|
|
|
|
|
139595
|
push @{$Sp->[$p]}, $q; |
|
126907
|
|
|
|
|
257873
|
|
547
|
|
|
|
|
|
|
} |
548
|
526493
|
|
|
|
|
644078
|
elsif ( f_dominates($P->[$q],$P->[$p], f_ineq2maxerr( &{$f_ineq}($VP->[$q]) ), f_ineq2maxerr( &{$f_ineq}($VP->[$p])) ) ){ |
|
526493
|
|
|
|
|
613497
|
|
549
|
124287
|
|
|
|
|
230153
|
$np->[$p] += 1; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
} |
552
|
6600
|
100
|
|
|
|
13128
|
if ($np->[$p] == 0){ |
553
|
1305
|
|
|
|
|
2702
|
$rank->[$p]=1; # front number, 1 = best |
554
|
1305
|
|
|
|
|
1731
|
push @{$F->[0]}, $p; |
|
1305
|
|
|
|
|
3212
|
|
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
# all other fronts |
559
|
66
|
|
|
|
|
117
|
my $i = 0; |
560
|
|
|
|
|
|
|
|
561
|
66
|
|
|
|
|
585
|
while (scalar(@{$F->[$i]})){ |
|
884
|
|
|
|
|
1867
|
|
562
|
818
|
|
|
|
|
1167
|
my @Q;# members of next front |
563
|
|
|
|
|
|
|
|
564
|
818
|
|
|
|
|
1044
|
foreach my $p(@{$F->[$i]}){ |
|
818
|
|
|
|
|
1171
|
|
565
|
6600
|
|
|
|
|
6523
|
foreach my $q(@{$Sp->[$p]}){ |
|
6600
|
|
|
|
|
10393
|
|
566
|
126907
|
|
|
|
|
128193
|
$np->[$q] -=1; |
567
|
126907
|
100
|
|
|
|
178207
|
if ($np->[$q] == 0){ |
568
|
5295
|
|
|
|
|
6058
|
$rank->[$q] = $i + 1 + 1; |
569
|
5295
|
|
|
|
|
6826
|
push @Q, $q; |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
818
|
|
|
|
|
816
|
$i++; |
574
|
818
|
|
|
|
|
2159
|
$F->[$i] = [@Q]; |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
} |
577
|
|
|
|
|
|
|
|
578
|
66
|
|
|
|
|
165
|
for my $p(0..$N-1){ |
579
|
6600
|
|
|
|
|
8100
|
push @out_print, join(' ',($rank->[$p],@{$P->[$p]})); |
|
6600
|
|
|
|
|
15377
|
|
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
66
|
|
|
|
|
3028
|
return ($rank,$F); # rank for each point, points in each front |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
######################################################################################################## |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
sub f_dominates { |
589
|
|
|
|
|
|
|
# input: two elements of P |
590
|
|
|
|
|
|
|
# output: 1 if P1 dominate P2, 0 otherwise |
591
|
|
|
|
|
|
|
|
592
|
1179893
|
|
|
1179893
|
0
|
1312236
|
my $P1 = shift; |
593
|
1179893
|
|
|
|
|
1209309
|
my $P2 = shift; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# constraints errors |
596
|
1179893
|
|
|
|
|
1176958
|
my $err1 = shift; |
597
|
1179893
|
|
|
|
|
1196395
|
my $err2 = shift; |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
# number of objective (dimensions) |
601
|
1179893
|
|
|
|
|
1166678
|
my $M = scalar(@{$P1}); |
|
1179893
|
|
|
|
|
1242205
|
|
602
|
|
|
|
|
|
|
|
603
|
1179893
|
|
|
|
|
1224381
|
my $P1_dominate_P2_count = 0; |
604
|
|
|
|
|
|
|
|
605
|
1179893
|
|
|
|
|
1576647
|
for my $kM(0..$M-1){ |
606
|
2359786
|
100
|
|
|
|
3538009
|
if ($P1->[$kM] <= $P2->[$kM]){ |
607
|
1306800
|
|
|
|
|
1492031
|
$P1_dominate_P2_count++; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
1179893
|
|
|
|
|
1151186
|
my $P1_dominate_P2_p; |
612
|
|
|
|
|
|
|
# if 1 has lower constraints errors, then 1 dominate 2, else if the error is the same (e.g 0) then the dominance is decided on objective value |
613
|
|
|
|
|
|
|
# else simply 1 doesn't dominate 2 |
614
|
1179893
|
100
|
66
|
|
|
3235003
|
if ( |
|
|
|
66
|
|
|
|
|
615
|
|
|
|
|
|
|
$err1 < $err2 |
616
|
|
|
|
|
|
|
|| |
617
|
|
|
|
|
|
|
($err1 == $err2 && $P1_dominate_P2_count == $M) |
618
|
|
|
|
|
|
|
){ |
619
|
251194
|
|
|
|
|
283552
|
$P1_dominate_P2_p = 1; |
620
|
|
|
|
|
|
|
} |
621
|
928699
|
|
|
|
|
1014256
|
else { $P1_dominate_P2_p = 0} |
622
|
|
|
|
|
|
|
|
623
|
1179893
|
|
|
|
|
2140191
|
return $P1_dominate_P2_p; |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
######################################################################################################## |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
sub f_crowding_distance_assignment{ |
630
|
|
|
|
|
|
|
# input: ref of array of a subset of population P, population P |
631
|
|
|
|
|
|
|
# output: distance value for each point of this set |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
# global ids of the set of non dominated points of interest |
634
|
331
|
|
|
331
|
0
|
443
|
my $ids = shift; |
635
|
|
|
|
|
|
|
# objectives of all points |
636
|
331
|
|
|
|
|
350
|
my $P = shift; |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# build the set of objectives for these global ids (I is a subset of P) |
639
|
331
|
|
|
|
|
368
|
my $I = [@{$P}[@{$ids}]]; |
|
331
|
|
|
|
|
1017
|
|
|
331
|
|
|
|
|
444
|
|
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# initialize distance |
642
|
331
|
|
|
|
|
420
|
my $Dist; |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# number of objective (dimensions) |
645
|
331
|
|
|
|
|
585
|
my $M = scalar(@{$P->[0]}); |
|
331
|
|
|
|
|
464
|
|
646
|
|
|
|
|
|
|
# number of points in I |
647
|
331
|
|
|
|
|
410
|
my $n = scalar(@{$ids}); |
|
331
|
|
|
|
|
374
|
|
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
# for each objective |
650
|
331
|
|
|
|
|
872
|
for my $kM(0..$M-1){ |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
# local id of the points, sorted by objective |
653
|
662
|
|
|
|
|
2426
|
my @index_sort = sort{$I->[$a][$kM] <=> $I->[$b][$kM]} 0..($n-1); |
|
21587
|
|
|
|
|
24890
|
|
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
# min & max for this objective |
656
|
662
|
|
|
|
|
1247
|
my $fmin = $I->[$index_sort[0]][$kM]; |
657
|
662
|
|
|
|
|
906
|
my $fmax = $I->[$index_sort[-1]][$kM]; |
658
|
|
|
|
|
|
|
|
659
|
662
|
50
|
|
|
|
1058
|
if ($fmax-$fmin<0.00001){$fmax += 0.00001} |
|
0
|
|
|
|
|
0
|
|
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# build the distance |
662
|
662
|
|
|
|
|
994
|
$Dist->[$index_sort[0]] = $inf; |
663
|
662
|
|
|
|
|
872
|
$Dist->[$index_sort[-1]] = $inf; |
664
|
|
|
|
|
|
|
# and for all other intermediate point |
665
|
662
|
|
|
|
|
931
|
for my $i(1..($n-2)){ |
666
|
6498
|
|
|
|
|
10822
|
$Dist->[$index_sort[$i]] += ($I->[$index_sort[$i+1]][$kM] - $I->[$index_sort[$i-1]][$kM])/($fmax-$fmin); |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
# return distances for each point, $Dist->[ith] is distance for point $ids->[ith] |
671
|
331
|
|
|
|
|
646
|
return $Dist; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
######################################################################################################## |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
sub f_crowding_distance_operator { |
677
|
|
|
|
|
|
|
# input: rank and distance of two element of the population (selected by GA) |
678
|
|
|
|
|
|
|
# output: 1 if first dominate second, else 0 |
679
|
|
|
|
|
|
|
|
680
|
6600
|
|
|
6600
|
0
|
7245
|
my $rank = shift; |
681
|
6600
|
|
|
|
|
6400
|
my $Dist = shift; |
682
|
|
|
|
|
|
|
|
683
|
6600
|
|
|
|
|
6511
|
my $P1_dominate_P2_p; |
684
|
|
|
|
|
|
|
|
685
|
6600
|
100
|
100
|
|
|
16939
|
if ( |
|
|
|
100
|
|
|
|
|
686
|
|
|
|
|
|
|
$rank->[0] < $rank->[1] |
687
|
|
|
|
|
|
|
|| |
688
|
|
|
|
|
|
|
($rank->[0] == $rank->[1]) && ($Dist->[0] > $Dist->[1]) |
689
|
|
|
|
|
|
|
){ |
690
|
3319
|
|
|
|
|
3554
|
$P1_dominate_P2_p = 1 |
691
|
|
|
|
|
|
|
} |
692
|
3281
|
|
|
|
|
3738
|
else {$P1_dominate_P2_p = 0} |
693
|
6600
|
|
|
|
|
8087
|
return $P1_dominate_P2_p; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
######################################################################################################## |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
sub f_NSGAII { |
699
|
|
|
|
|
|
|
# input: current function input values VP(t) & VQ(t) ( VQ is obtained by GA) |
700
|
|
|
|
|
|
|
# current population Pt & Qt (obtained by evaluating objective function using VPt & VQt) |
701
|
|
|
|
|
|
|
# output: VP(t+1), P(t+1), rank & distance for each point of this new population |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
# input variables' values |
704
|
66
|
|
|
66
|
0
|
508
|
my $VPt = shift; |
705
|
66
|
|
|
|
|
276
|
my $VQt = shift; |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
# population (objective function values) |
708
|
66
|
|
|
|
|
325
|
my $Pt = shift; |
709
|
66
|
|
|
|
|
153
|
my $Qt = shift; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
# constraints function |
712
|
66
|
|
|
|
|
362
|
my $f_ineq = shift; |
713
|
|
|
|
|
|
|
|
714
|
66
|
|
|
|
|
5385
|
my $Rt = [(@$Pt,@$Qt)]; |
715
|
66
|
|
|
|
|
7555
|
my $VRt = [(@$VPt,@$VQt)]; |
716
|
66
|
|
|
|
|
194
|
my $N = scalar(@$Pt); |
717
|
|
|
|
|
|
|
|
718
|
66
|
|
|
|
|
605
|
my ($temp,$F) = f_fast_non_dominated_sort($Rt,$VRt,$f_ineq); |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# input variables for the new population P_t+1 |
721
|
66
|
|
|
|
|
227
|
my $VPtp1=[]; |
722
|
|
|
|
|
|
|
# new population |
723
|
66
|
|
|
|
|
133
|
my $Ptp1=[]; |
724
|
66
|
|
|
|
|
96
|
my $Dist=[]; |
725
|
66
|
|
|
|
|
90
|
my $rank=[]; |
726
|
|
|
|
|
|
|
|
727
|
66
|
|
|
|
|
98
|
my $i=0; |
728
|
|
|
|
|
|
|
# push the best fronts in final population & store crowding distance |
729
|
66
|
|
|
|
|
136
|
while ( scalar(@{$Ptp1}) + scalar(@{$F->[$i]}) <= $N ){ |
|
331
|
|
|
|
|
436
|
|
|
331
|
|
|
|
|
748
|
|
730
|
265
|
|
|
|
|
359
|
push @$Ptp1, @$Rt[@{$F->[$i]}]; |
|
265
|
|
|
|
|
819
|
|
731
|
265
|
|
|
|
|
349
|
push @$VPtp1,@$VRt[@{$F->[$i]}]; |
|
265
|
|
|
|
|
747
|
|
732
|
265
|
|
|
|
|
533
|
my $Dist_ = f_crowding_distance_assignment($F->[$i],$Rt); |
733
|
265
|
|
|
|
|
721
|
push @$rank, ($i+1) x @$Dist_; |
734
|
265
|
|
|
|
|
549
|
push @$Dist, @$Dist_; |
735
|
265
|
|
|
|
|
413
|
$i++; |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# only part of the following front will be pushed in final population, sorting by crowding |
739
|
|
|
|
|
|
|
# here rank is the same for all points, so the crowded-comparison operators reduce to a comparison of crowding distance |
740
|
66
|
|
|
|
|
219
|
my $Dist_ = f_crowding_distance_assignment($F->[$i],$Rt); |
741
|
|
|
|
|
|
|
|
742
|
66
|
|
|
|
|
118
|
my $nf = scalar(@{$F->[$i]}); |
|
66
|
|
|
|
|
359
|
|
743
|
|
|
|
|
|
|
|
744
|
66
|
|
|
|
|
273
|
my @index_sort = sort{$Dist_->[$b] <=> $Dist_->[$a]} 0..($nf-1); |
|
4998
|
|
|
|
|
5732
|
|
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# cut to fill only the remaining part of Ptp1 |
747
|
66
|
|
|
|
|
298
|
@index_sort = @index_sort[0..(($N-scalar(@$Ptp1))-1)]; |
748
|
|
|
|
|
|
|
|
749
|
66
|
|
|
|
|
158
|
push @$Ptp1, @$Rt[@{$F->[$i]}[@index_sort]]; |
|
66
|
|
|
|
|
264
|
|
750
|
66
|
|
|
|
|
158
|
push @$VPtp1, @$VRt[@{$F->[$i]}[@index_sort]]; |
|
66
|
|
|
|
|
286
|
|
751
|
66
|
|
|
|
|
416
|
push @$rank, ($i+1) x @index_sort; |
752
|
66
|
|
|
|
|
402
|
push @$Dist, @$Dist_[@index_sort]; |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
|
755
|
66
|
|
|
|
|
1358
|
return $VPtp1,$Ptp1,$rank,$Dist; |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
######################################################################################################## |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub f_SBX { |
762
|
3300
|
|
|
3300
|
0
|
3634
|
my $contiguity = shift; # >0 (usually between 2 and 5), greater value produces child values similar to those of the parents |
763
|
3300
|
|
|
|
|
3334
|
my $VP1_ = shift; # input values of parent 1 (ref) |
764
|
3300
|
|
|
|
|
3401
|
my $VP2_ = shift; # input values of parent 2 (ref) |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# array of equal length |
767
|
3300
|
|
|
|
|
4820
|
my @VP1 = @$VP1_; |
768
|
3300
|
|
|
|
|
4090
|
my @VP2 = @$VP2_; |
769
|
3300
|
|
|
|
|
3547
|
my @out; |
770
|
|
|
|
|
|
|
|
771
|
3300
|
|
|
|
|
4859
|
for my $kp(0..$#VP1){ |
772
|
|
|
|
|
|
|
# for array of length=1 or rand<0.5 the cross is made |
773
|
9900
|
100
|
66
|
|
|
21972
|
if ( $#VP1 == 0 || rand(1)<0.5){ |
774
|
|
|
|
|
|
|
|
775
|
4712
|
|
|
|
|
5262
|
my $u = rand(1); |
776
|
|
|
|
|
|
|
|
777
|
4712
|
|
|
|
|
6010
|
my $exponent = (1/($contiguity+1)); |
778
|
4712
|
100
|
|
|
|
9230
|
my $beta = ($u < 0.5)? (2*$u)**$exponent : (0.5/(1-$u))**$exponent; |
779
|
|
|
|
|
|
|
|
780
|
4712
|
100
|
|
|
|
6260
|
my $sign = (rand(1) < 0.5)? -1 : 1; |
781
|
4712
|
|
|
|
|
10248
|
$out[$kp] = (($VP1[$kp] + $VP2[$kp])/2) + $sign * $beta*0.5*abs($VP1[$kp] - $VP2[$kp]) |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
} |
784
|
|
|
|
|
|
|
else { |
785
|
5188
|
|
|
|
|
7446
|
$out[$kp] = $VP1[$kp] |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
} |
788
|
3300
|
|
|
|
|
5484
|
return \@out; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
######################################################################################################## |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
sub f_GA { |
794
|
|
|
|
|
|
|
# input: input values, rank and Dist of the population P(t+1) |
795
|
|
|
|
|
|
|
# output: input value of the population Q(t+1) |
796
|
|
|
|
|
|
|
|
797
|
66
|
|
|
66
|
0
|
115
|
my $VPtp1 = shift; |
798
|
66
|
|
|
|
|
242
|
my $rank = shift; |
799
|
66
|
|
|
|
|
100
|
my $Dist = shift; |
800
|
66
|
|
|
|
|
79
|
my $contiguity = shift; |
801
|
|
|
|
|
|
|
|
802
|
66
|
|
|
|
|
106
|
my $bounds = shift; # for mutation |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# optional paramters for mutation: |
805
|
66
|
|
|
|
|
95
|
my $distrib = shift; |
806
|
66
|
|
|
|
|
93
|
my $scaleDistrib = shift; |
807
|
66
|
|
|
|
|
99
|
my $percentMut =shift; |
808
|
|
|
|
|
|
|
|
809
|
66
|
|
|
|
|
102
|
my $VQtp1 = []; |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
# binary tournament |
812
|
|
|
|
|
|
|
# two random element are compared |
813
|
|
|
|
|
|
|
# the best according crowding distance operator is selected as parent 1 |
814
|
|
|
|
|
|
|
# the same for selecting parent 2 |
815
|
|
|
|
|
|
|
# parent 1 and 2 are crossed with SBX to give a child |
816
|
|
|
|
|
|
|
# the procedure is repeated to fill Q(t+1) |
817
|
|
|
|
|
|
|
|
818
|
66
|
|
|
|
|
116
|
my $N = scalar(@$VPtp1); |
819
|
|
|
|
|
|
|
|
820
|
66
|
|
|
|
|
461
|
for my $kt(0..$N-1){ |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
# selection of the two parent |
823
|
3300
|
|
|
|
|
3449
|
my @index_parent; |
824
|
3300
|
|
|
|
|
5801
|
for (1..2){ |
825
|
6600
|
|
|
|
|
9963
|
my ($r1,$r2) = (int(rand($N)),int(rand($N))); |
826
|
6600
|
|
|
|
|
12201
|
my $P1_dominate_P2_p = f_crowding_distance_operator( [$rank->[$r1],$rank->[$r2]] , [$Dist->[$r1],$Dist->[$r2]] ); |
827
|
|
|
|
|
|
|
|
828
|
6600
|
100
|
|
|
|
10730
|
if ($P1_dominate_P2_p == 1){push @index_parent, $r1} |
|
3319
|
|
|
|
|
4776
|
|
829
|
3281
|
|
|
|
|
4720
|
else {push @index_parent, $r2} |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
# crossover of the two parent |
832
|
3300
|
|
|
|
|
5199
|
my $out = f_SBX( $contiguity , $VPtp1->[$index_parent[0]] , $VPtp1->[$index_parent[1]] ); |
833
|
3300
|
|
|
|
|
5019
|
push @$VQtp1, $out; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
# mutation 1 |
837
|
|
|
|
|
|
|
# perturbation using distribution array |
838
|
66
|
|
|
|
|
613
|
for my $k(0..(scalar(@$VQtp1) - 1)){ |
839
|
|
|
|
|
|
|
# $percentMut percentage of individuals are changed in all their elements (all input parameter will be perturbated) |
840
|
3300
|
100
|
|
|
|
5039
|
if (rand(1)> 1-$percentMut/100){ |
841
|
182
|
|
|
|
|
186
|
for my $d(0..(scalar(@{$VQtp1->[0]}) - 1)){ |
|
182
|
|
|
|
|
313
|
|
842
|
|
|
|
|
|
|
# increment the current value by a random value chosen from the distribution (many time it will be near to zero for a gaussian distribution) scaled with the delta_bounds |
843
|
546
|
|
|
|
|
1098
|
$VQtp1->[$k][$d] += ($bounds->[$d][1] - $bounds->[$d][0]) * $scaleDistrib * $distrib->[int(rand(scalar(@$distrib)))]; |
844
|
|
|
|
|
|
|
} |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
# mutation 2 |
849
|
|
|
|
|
|
|
# 100% probability of mutation inside VQ(t+1), so the intention is to act on all individual of the population |
850
|
66
|
|
|
|
|
204
|
for my $k(0..int((scalar(@$VQtp1) - 1) * 100/100)){ |
851
|
3300
|
|
|
|
|
3230
|
for my $d(0..(scalar(@{$VQtp1->[0]}) - 1)){ |
|
3300
|
|
|
|
|
3915
|
|
852
|
|
|
|
|
|
|
# $percentMut percentage of values are changed inside each single individual, value is inside bounds |
853
|
9900
|
100
|
|
|
|
14903
|
if (rand(1)> 1-$percentMut/100){ |
854
|
457
|
|
|
|
|
745
|
$VQtp1->[$k][$d] = rand(1) * ($bounds->[$d][1] - $bounds->[$d][0]) + $bounds->[$d][0]; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
} |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
66
|
|
|
|
|
151
|
return $VQtp1; |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
sub f_Optim_NSGAII { |
866
|
|
|
|
|
|
|
|
867
|
12
|
|
|
12
|
1
|
3228
|
my $par = shift; |
868
|
|
|
|
|
|
|
|
869
|
12
|
|
|
|
|
24
|
my $par_plot = shift; |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
|
873
|
12
|
|
|
|
|
24
|
my %par = %{$par}; |
|
12
|
|
|
|
|
60
|
|
874
|
|
|
|
|
|
|
|
875
|
12
|
|
|
|
|
36
|
my $nPop = $par{'nPop'}; |
876
|
12
|
|
|
|
|
24
|
my $nGen = $par{'nGen'}; |
877
|
|
|
|
|
|
|
|
878
|
12
|
|
|
|
|
24
|
my $bounds = $par{'bounds'}; |
879
|
12
|
|
|
|
|
24
|
my $n = scalar @$bounds; |
880
|
|
|
|
|
|
|
|
881
|
12
|
|
|
|
|
24
|
my $fun = $par{'function'}; |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
# optional paramters: |
884
|
|
|
|
|
|
|
|
885
|
12
|
|
50
|
2359786
|
|
108
|
my $f_ineq = $par{'f_ineq'} // sub {return [0]}; |
|
2359786
|
|
|
|
|
3312041
|
|
886
|
|
|
|
|
|
|
|
887
|
12
|
|
50
|
|
|
36
|
my $verboseFinal = $par{'verboseFinal'} // 1; |
888
|
|
|
|
|
|
|
|
889
|
12
|
|
50
|
|
|
36
|
my $distrib = $par{'distrib'} // [-1,-0.5,0,0.5,1]; # for mutation, default [-1,-0.5,0,0.5,1] |
890
|
12
|
|
50
|
|
|
36
|
my $scaleDistrib = $par{'scaleDistrib'} // 0; # for mutation, default = 0, no perturbation |
891
|
12
|
|
50
|
|
|
48
|
my $percentMut = $par{'percentMut'} // 5; # for mutation, default = 5% |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
# control for no wrong use of keys |
894
|
12
|
|
|
|
|
60
|
my @keys_ok = ('nPop','nGen','bounds','function','nProc','filesDir','verboseFinal','f_ineq','distrib','scaleDistrib','percentMut'); |
895
|
12
|
|
|
|
|
48
|
for my $key(keys %par){ |
896
|
108
|
50
|
|
|
|
1512
|
unless ( grep( /^$key$/, @keys_ok ) ) { |
897
|
0
|
|
|
|
|
0
|
die 'E R R O R : the use of "'.$key.'" in the function to optimize is not defined! Compare with documentation.'; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
12
|
|
|
|
|
36
|
my $VPt; |
902
|
|
|
|
|
|
|
my $VQt; |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
|
905
|
12
|
|
|
|
|
36
|
for my $gen(0..$nGen){ |
906
|
77
|
100
|
|
|
|
310
|
if ($gen == 0){ |
907
|
|
|
|
|
|
|
# input |
908
|
12
|
|
|
|
|
48
|
for (0..$nPop-1){ |
909
|
600
|
|
|
|
|
708
|
$VPt->[$_]=[map { rand(1) * ($bounds->[$_-1][1] - $bounds->[$_-1][0]) + $bounds->[$_-1][0] } 1..$n]; |
|
1800
|
|
|
|
|
3012
|
|
910
|
600
|
|
|
|
|
768
|
$VQt->[$_]=[map { rand(1) * ($bounds->[$_-1][1] - $bounds->[$_-1][0]) + $bounds->[$_-1][0] } 1..$n]; |
|
1800
|
|
|
|
|
3120
|
|
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
|
919
|
77
|
|
|
|
|
228
|
my $nProc = $par{'nProc'}; |
920
|
77
|
|
|
|
|
151
|
my $filesDir = $par{'filesDir'}; |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
# if ($nPop%$nProc != 0){warn "\n nPop should be divisible by nProc!\n\n"}; |
923
|
|
|
|
|
|
|
|
924
|
77
|
|
|
|
|
134
|
my $fork = 0; |
925
|
|
|
|
|
|
|
|
926
|
77
|
|
|
|
|
222
|
for (1..$nProc){ |
927
|
|
|
|
|
|
|
|
928
|
77
|
|
|
|
|
82794
|
my $pid = fork; |
929
|
77
|
50
|
|
|
|
1977
|
die $! unless defined $pid; |
930
|
77
|
|
|
|
|
368
|
$fork++; |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
# say "in PID = $$ with child PID = $pid fork# = $fork"; |
933
|
|
|
|
|
|
|
# parent process stop here, child processes go on |
934
|
77
|
100
|
|
|
|
2366
|
next if $pid; |
935
|
|
|
|
|
|
|
|
936
|
11
|
|
|
|
|
1378
|
my $r = 0; |
937
|
|
|
|
|
|
|
|
938
|
11
|
|
|
|
|
799
|
my $nameFileP = $filesDir.'/Pt_'.$fork.'.txt'; |
939
|
11
|
|
|
|
|
238
|
my $nameFileQ = $filesDir.'/Qt_'.$fork.'.txt'; |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
# remove existing input file for this process number |
942
|
11
|
|
|
|
|
31503
|
system ('rm -f '.$nameFileP); |
943
|
11
|
|
|
|
|
32869
|
system ('rm -f '.$nameFileQ); |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
|
946
|
11
|
|
|
|
|
516
|
my $id_from = ($fork-1)*int($nPop/$nProc); |
947
|
11
|
|
|
|
|
200
|
my $id_to = $fork *int($nPop/$nProc)-1; |
948
|
11
|
50
|
|
|
|
679
|
if ($fork == $nProc){$id_to = $nPop - 1}; |
|
11
|
|
|
|
|
118
|
|
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
# output |
951
|
11
|
50
|
|
|
|
2838
|
open my $fileoP, '>>', $nameFileP or croak "E R R O R : problem in writing the file ".$nameFileP.' -> "filesDir" path not reachable? -- '; |
952
|
11
|
50
|
|
|
|
938
|
open my $fileoQ, '>>', $nameFileQ or croak "E R R O R : problem in writing the file ".$nameFileQ.' -> "filesDir" path not reachable? -- '; |
953
|
11
|
|
|
|
|
165
|
for ($id_from .. $id_to){ |
954
|
550
|
|
|
|
|
857
|
my $Pt_ = &{$fun}($VPt->[$_]); |
|
550
|
|
|
|
|
2364
|
|
955
|
550
|
|
|
|
|
11920
|
my $Qt_ = &{$fun}($VQt->[$_]); |
|
550
|
|
|
|
|
1926
|
|
956
|
550
|
|
|
|
|
11044
|
say $fileoP join ',',@{$Pt_}; |
|
550
|
|
|
|
|
6198
|
|
957
|
550
|
|
|
|
|
738
|
say $fileoQ join ',',@{$Qt_}; |
|
550
|
|
|
|
|
2199
|
|
958
|
|
|
|
|
|
|
} |
959
|
11
|
|
|
|
|
735
|
close $fileoP; |
960
|
11
|
|
|
|
|
384
|
close $fileoQ; |
961
|
11
|
|
|
|
|
10510
|
exit; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
# wait for the processes to finish |
965
|
66
|
|
|
|
|
222
|
my $kid; |
966
|
66
|
|
|
|
|
94
|
do { |
967
|
132
|
|
|
|
|
22684665
|
$kid = waitpid -1, 0; |
968
|
|
|
|
|
|
|
} while ($kid>0); |
969
|
|
|
|
|
|
|
|
970
|
66
|
|
|
|
|
265
|
my $Pt; |
971
|
|
|
|
|
|
|
my $Qt; |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
# collect data together |
974
|
66
|
|
|
|
|
834
|
for (1..$nProc){ |
975
|
|
|
|
|
|
|
|
976
|
66
|
|
|
|
|
1462
|
my $nameFileP = $filesDir.'/Pt_'.$_.'.txt'; |
977
|
66
|
|
|
|
|
664
|
my $nameFileQ = $filesDir.'/Qt_'.$_.'.txt'; |
978
|
66
|
50
|
|
|
|
7011
|
open my $fileiP, '<', $nameFileP or croak "E R R O R : problem in reading the file ".$nameFileP.' -> "filesDir" path not reachable? '; |
979
|
66
|
50
|
|
|
|
3588
|
open my $fileiQ, '<', $nameFileQ or croak "E R R O R : problem in reading the file ".$nameFileQ.' -> "filesDir" path not reachable? '; |
980
|
|
|
|
|
|
|
|
981
|
66
|
|
|
|
|
12620
|
while (my $line = <$fileiP>){ |
982
|
3300
|
|
|
|
|
4370
|
chomp $line; |
983
|
3300
|
|
|
|
|
8536
|
my @vals = split ',', $line; |
984
|
3300
|
|
|
|
|
9799
|
push @$Pt, \@vals; |
985
|
|
|
|
|
|
|
} |
986
|
66
|
|
|
|
|
1716
|
while (my $line = <$fileiQ>){ |
987
|
3300
|
|
|
|
|
3917
|
chomp $line; |
988
|
3300
|
|
|
|
|
6445
|
my @vals = split ',', $line; |
989
|
3300
|
|
|
|
|
9267
|
push @$Qt, \@vals; |
990
|
|
|
|
|
|
|
} |
991
|
66
|
|
|
|
|
848
|
close $fileiP; |
992
|
66
|
|
|
|
|
783
|
close $fileiQ; |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# new input |
998
|
66
|
|
|
|
|
967
|
my ($VPtp1,$Ptp1,$rank,$Dist)=f_NSGAII($VPt,$VQt,$Pt,$Qt,$f_ineq); |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
# save inputs and corresponding outputs at this generation |
1001
|
66
|
|
|
|
|
159
|
my $to_print; |
1002
|
|
|
|
|
|
|
my $FILEO; |
1003
|
|
|
|
|
|
|
# inputs (genes for each individual) |
1004
|
66
|
50
|
|
|
|
8920
|
open $FILEO, '>', $filesDir.'/VPt_gen'.sprintf('%05d',$gen).'.txt' or croak 'E R R O R : problem in writing the generation file -> "filesDir" path not reachable? '; |
1005
|
66
|
|
|
|
|
821
|
$to_print = f_print_columns($VPt,'%25.15f'); |
1006
|
66
|
|
|
|
|
2307
|
print $FILEO (join "\n", @$to_print); |
1007
|
66
|
|
|
|
|
3193
|
close $FILEO; |
1008
|
|
|
|
|
|
|
# outputs (f1, f2 ... for each individual) |
1009
|
66
|
50
|
|
|
|
4412
|
open $FILEO, '>', $filesDir.'/Pt_gen'.sprintf('%05d',$gen).'.txt' or croak 'E R R O R : problem in writing the generation file -> "filesDir" path not reachable? '; |
1010
|
66
|
|
|
|
|
297
|
$to_print = f_print_columns($Pt,'%25.15f'); |
1011
|
66
|
|
|
|
|
803
|
print $FILEO (join "\n", @$to_print); |
1012
|
66
|
|
|
|
|
1848
|
close $FILEO; |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
#print " example input values: " ; |
1016
|
|
|
|
|
|
|
#say join ' ', @{$VPtp1->[0]}; |
1017
|
|
|
|
|
|
|
|
1018
|
66
|
50
|
|
|
|
286
|
if (defined $par_plot){ |
1019
|
0
|
|
|
|
|
0
|
f_plot($par_plot,$gen,$Ptp1,$rank); |
1020
|
0
|
|
|
|
|
0
|
say ''; |
1021
|
|
|
|
|
|
|
|
1022
|
0
|
|
|
|
|
0
|
my $max = -$inf; |
1023
|
0
|
|
|
|
|
0
|
my $min = $inf; |
1024
|
|
|
|
|
|
|
|
1025
|
0
|
|
|
|
|
0
|
for (0..$nPop-1){ |
1026
|
0
|
|
|
|
|
0
|
$max = max(@{$Pt->[$_]},@{$Qt->[$_]},$max); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1027
|
0
|
|
|
|
|
0
|
$min = min(@{$Pt->[$_]},@{$Qt->[$_]},$min); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1028
|
|
|
|
|
|
|
} |
1029
|
0
|
|
|
|
|
0
|
say 'max output = '.$max; |
1030
|
0
|
|
|
|
|
0
|
say 'min output = '.$min; |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
|
1033
|
0
|
|
|
|
|
0
|
my $maxV = -$inf; |
1034
|
0
|
|
|
|
|
0
|
my $minV= $inf; |
1035
|
|
|
|
|
|
|
|
1036
|
0
|
|
|
|
|
0
|
my $minD = min(@$Dist); |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
|
1039
|
0
|
|
|
|
|
0
|
for (0..$nPop-1){ |
1040
|
|
|
|
|
|
|
|
1041
|
0
|
|
|
|
|
0
|
$maxV = max(@{$VPt->[$_]},@{$VQt->[$_]},$maxV); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1042
|
0
|
|
|
|
|
0
|
$minV = min(@{$VPt->[$_]},@{$VQt->[$_]},$minV); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
} |
1045
|
0
|
|
|
|
|
0
|
say 'max input = '.$maxV; |
1046
|
0
|
|
|
|
|
0
|
say 'min input = '.$minV; |
1047
|
|
|
|
|
|
|
|
1048
|
0
|
|
|
|
|
0
|
say 'min Dist = '.$minD; |
1049
|
|
|
|
|
|
|
} |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
|
1052
|
66
|
|
|
|
|
373
|
my ($VQtp1) = f_GA($VPtp1,$rank,$Dist,2.0,$bounds,$distrib,$scaleDistrib,$percentMut); |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
# correction of input values produced by GA to respect bounds |
1055
|
66
|
|
|
|
|
151
|
for my $p(0..$nPop-1){ |
1056
|
3300
|
|
|
|
|
3786
|
for my $d(0..$n-1){ |
1057
|
9900
|
100
|
|
|
|
13638
|
if($VQtp1->[$p][$d] < $bounds->[$d][0]){$VQtp1->[$p][$d] = $bounds->[$d][0]}; |
|
44
|
|
|
|
|
44
|
|
1058
|
9900
|
100
|
|
|
|
15363
|
if($VQtp1->[$p][$d] > $bounds->[$d][1]){$VQtp1->[$p][$d] = $bounds->[$d][1]}; |
|
36
|
|
|
|
|
83
|
|
1059
|
|
|
|
|
|
|
} |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
# new output |
1063
|
66
|
|
|
|
|
127
|
my $Qtp1; |
1064
|
66
|
|
|
|
|
262
|
for (0..$nPop-1){ |
1065
|
3300
|
|
|
|
|
45613
|
$Qtp1->[$_]=&{$fun}($VQtp1->[$_]); |
|
3300
|
|
|
|
|
5231
|
|
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
# new became old |
1069
|
66
|
|
|
|
|
3652
|
$VPt = [@$VPtp1]; |
1070
|
66
|
|
|
|
|
2753
|
$VQt = [@$VQtp1]; |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
# output final |
1074
|
66
|
100
|
|
|
|
3223
|
if($gen == $nGen){ |
1075
|
1
|
50
|
|
|
|
19
|
if ($verboseFinal == 1){ |
1076
|
0
|
|
|
|
|
0
|
say '------------------------- I N P U T -------------------------:'; |
1077
|
0
|
|
|
|
|
0
|
map {say join ' ',@{$_}} @$VPt; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1078
|
0
|
|
|
|
|
0
|
say '------------------------- O U T P U T -------------------------'; |
1079
|
0
|
|
|
|
|
0
|
map {say join ' ',@{$_}} @$Pt; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
1
|
|
|
|
|
101
|
return [$VPt,$Pt]; |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
} |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
sub f_print_columns { |
1093
|
|
|
|
|
|
|
# to print in columns format the content of $P, $Ptp1 ... |
1094
|
132
|
|
|
132
|
0
|
322
|
my $P = shift; |
1095
|
132
|
|
|
|
|
695
|
my $formato = shift; # e.g. '%25.15f' |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
# how many input parameters (genes) |
1098
|
132
|
|
|
|
|
252
|
my $n = scalar @{$P->[0]}; |
|
132
|
|
|
|
|
318
|
|
1099
|
|
|
|
|
|
|
# population number |
1100
|
132
|
|
|
|
|
225
|
my $nPop = scalar @$P; |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
# print, each line contains the genes of an individual |
1103
|
132
|
|
|
|
|
199
|
my @to_print; |
1104
|
132
|
|
|
|
|
644
|
for my $kl(0..($nPop-1)){ |
1105
|
6600
|
|
|
|
|
6724
|
my $line; |
1106
|
6600
|
|
|
|
|
8144
|
for my $kx(0..($n-1)){ |
1107
|
16500
|
|
|
|
|
47094
|
$line.= sprintf($formato,$P->[$kl][$kx]) . ' '; |
1108
|
|
|
|
|
|
|
} |
1109
|
6600
|
|
|
|
|
10589
|
push @to_print, $line; |
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
|
1112
|
132
|
|
|
|
|
506
|
return \@to_print; |
1113
|
|
|
|
|
|
|
} |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
######################################################################################################## |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
sub f_plot { |
1118
|
0
|
|
|
0
|
0
|
|
my $par_ref = shift; |
1119
|
|
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
|
my $gen = shift; |
1121
|
|
|
|
|
|
|
|
1122
|
0
|
|
|
|
|
|
my $P = shift; |
1123
|
0
|
|
|
|
|
|
my $rank = shift; |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
|
1128
|
0
|
|
|
|
|
|
my %par = %{$par_ref}; |
|
0
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
# nfun: what objective to plot from all (x=f1 y=f4 -> [0,3]) |
1131
|
0
|
|
|
|
|
|
my $nfun = $par{'nfun'}; |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
|
1134
|
0
|
|
|
|
|
|
my $title = 'GENERATION '.$gen; |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
# inizialization of all lines of output |
1137
|
0
|
|
|
|
|
|
my @output = map{ ' ' x $par{'dx'} } 1..$par{'dy'}; |
|
0
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
|
1139
|
0
|
|
|
|
|
|
my @nameFront =(0..9,"a".."z","A".."Z"); |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
# print points of the front |
1142
|
0
|
|
|
|
|
|
my $xASCIImin = 0; |
1143
|
0
|
|
|
|
|
|
my $xASCIImax = $par{'dx'}-1; |
1144
|
0
|
|
|
|
|
|
my $yASCIImin = $par{'dy'}-1; |
1145
|
0
|
|
|
|
|
|
my $yASCIImax = 0; |
1146
|
0
|
|
|
|
|
|
my $n_outliers = 0; |
1147
|
|
|
|
|
|
|
|
1148
|
0
|
|
|
|
|
|
for my $kp(1..scalar(@{$P})-1){ |
|
0
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
# conversion x,y -> xASCII,yASCII |
1150
|
0
|
|
|
|
|
|
my $x = $P->[$kp][$nfun->[0]]; |
1151
|
0
|
|
|
|
|
|
my $y = $P->[$kp][$nfun->[1]]; |
1152
|
0
|
|
|
|
|
|
my $xmin = $par{'xlim'}->[0]; |
1153
|
0
|
|
|
|
|
|
my $xmax = $par{'xlim'}->[1]; |
1154
|
0
|
|
|
|
|
|
my $ymin = $par{'ylim'}->[0]; |
1155
|
0
|
|
|
|
|
|
my $ymax = $par{'ylim'}->[1]; |
1156
|
|
|
|
|
|
|
|
1157
|
0
|
|
|
|
|
|
my $xASCII; |
1158
|
|
|
|
|
|
|
my $yASCII; |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
|
1161
|
0
|
0
|
0
|
|
|
|
if ($x < $xmax && $x > $xmin && $y < $ymax && $y > $ymin && $rank->[$kp] < $#nameFront){ |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1162
|
0
|
|
|
|
|
|
$xASCII = f_interp($xmin,$xmax,$xASCIImin,$xASCIImax,$x); |
1163
|
0
|
|
|
|
|
|
$yASCII = f_interp($ymin,$ymax,$yASCIImin,$yASCIImax,$y); |
1164
|
|
|
|
|
|
|
|
1165
|
0
|
|
|
|
|
|
substr($output[$yASCII],$xASCII,1,$nameFront[$rank->[$kp]]); |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
} |
1168
|
0
|
|
|
|
|
|
else {$n_outliers++}; |
1169
|
|
|
|
|
|
|
} |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
# add axis |
1172
|
0
|
|
|
|
|
|
push @output, '_' x $par{'dx'}; |
1173
|
0
|
|
|
|
|
|
@output = map{'|'.$_} @output; |
|
0
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
# add axis labels |
1175
|
0
|
|
|
|
|
|
push @output, sprintf("%$par{'dx'}s",$par{'xlabel'}); |
1176
|
0
|
|
|
|
|
|
my @ylabelv = split '',$par{'ylabel'}; |
1177
|
0
|
0
|
|
|
|
|
@output = map{ defined $ylabelv[$_] ? $ylabelv[$_].$output[$_] : ' '.$output[$_]} 0..$#output; |
|
0
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
# add statistics |
1179
|
0
|
|
|
|
|
|
unshift @output, sprintf("%".int(($par{'dx'}+length($title))/2)."s",$title); |
1180
|
0
|
|
|
|
|
|
push @output, "xlim: ".(join ' ',@{$par{'xlim'}}); |
|
0
|
|
|
|
|
|
|
1181
|
0
|
|
|
|
|
|
push @output, "ylim: ".(join ' ',@{$par{'ylim'}}); |
|
0
|
|
|
|
|
|
|
1182
|
0
|
|
|
|
|
|
push @output, "#outliers: ".$n_outliers; |
1183
|
|
|
|
|
|
|
|
1184
|
0
|
|
|
|
|
|
print join "\n", @output; |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
} |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
sub f_interp{ |
1190
|
0
|
|
|
0
|
0
|
|
my ($xmin,$xmax,$xASCIImin,$xASCIImax,$x) = @_; |
1191
|
0
|
|
|
|
|
|
my $xASCII = ($xASCIImax-$xASCIImin)/($xmax-$xmin)*($x-$xmin)+$xASCIImin; |
1192
|
0
|
|
|
|
|
|
$xASCII = sprintf("%.0f",$xASCII); |
1193
|
0
|
|
|
|
|
|
return $xASCII |
1194
|
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
|
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
|
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
1; |