line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Optimization::NSGAII; |
2
|
|
|
|
|
|
|
|
3
|
23
|
|
|
23
|
|
1951021
|
use 5.006; |
|
23
|
|
|
|
|
69
|
|
4
|
23
|
|
|
23
|
|
207
|
use warnings; |
|
23
|
|
|
|
|
46
|
|
|
23
|
|
|
|
|
460
|
|
5
|
23
|
|
|
23
|
|
92
|
use strict; |
|
23
|
|
|
|
|
46
|
|
|
23
|
|
|
|
|
805
|
|
6
|
|
|
|
|
|
|
|
7
|
23
|
|
|
23
|
|
115
|
use feature 'say'; |
|
23
|
|
|
|
|
23
|
|
|
23
|
|
|
|
|
2461
|
|
8
|
23
|
|
|
23
|
|
115
|
use Exporter; |
|
23
|
|
|
|
|
46
|
|
|
23
|
|
|
|
|
1104
|
|
9
|
|
|
|
|
|
|
our @ISA = ("Exporter"); |
10
|
23
|
|
|
23
|
|
35121
|
use Data::Dumper; |
|
23
|
|
|
|
|
133055
|
|
|
23
|
|
|
|
|
1196
|
|
11
|
23
|
|
|
23
|
|
138
|
use List::Util qw/min max/; |
|
23
|
|
|
|
|
46
|
|
|
23
|
|
|
|
|
2047
|
|
12
|
23
|
|
|
23
|
|
138
|
use Carp; |
|
23
|
|
|
|
|
23
|
|
|
23
|
|
|
|
|
88688
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=pod |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Optimization::NSGAII - non dominant sorting genetic algorithm for multi-objective optimization (also known as NSGA2) |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 VERSION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Version 0.02 |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=cut |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our $VERSION = "0.02"; |
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
|
|
|
|
|
|
|
'startPop' => [[0.3,0.18,-0.1],# initial population |
114
|
|
|
|
|
|
|
[-0.38,0.5,0.1], # default: random population satisfying the bounds |
115
|
|
|
|
|
|
|
..., |
116
|
|
|
|
|
|
|
] |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
}, |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# the following is the optional set of parameters for 'Pareto front' 2D live plot |
121
|
|
|
|
|
|
|
# if the part below is not present, no plot will be made |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
{ |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
'dx' => 200, # characters width and height of the plot |
126
|
|
|
|
|
|
|
'dy' => 40, |
127
|
|
|
|
|
|
|
'xlabel' => 'stiffness [N/mm]', # horizontal and vertical axis labels |
128
|
|
|
|
|
|
|
'ylabel' => 'mass [kg]', |
129
|
|
|
|
|
|
|
'xlim' => [0,1], # horizontal and vertical axis limits |
130
|
|
|
|
|
|
|
'ylim' => [0,1], |
131
|
|
|
|
|
|
|
'nfun' => [0,2], # which function to plot from return value by f_to_optimize ($out) ; 0=f1, 1=f2 ... |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# U S E S O L U T I O N S |
136
|
|
|
|
|
|
|
############################ |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# for example print of the input parameters and |
139
|
|
|
|
|
|
|
# corresponding output functions' values of the final found Pareto front |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
my @ref_input = @{$ref_input_output->[0]}; |
142
|
|
|
|
|
|
|
my @ref_output = @{$ref_input_output->[1]}; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
print Dumper(\@ref_input); |
145
|
|
|
|
|
|
|
print Dumper(\@ref_output); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=head1 EXPORT |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=over |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=item * f_Optim_NSGAII |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=back |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=cut |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
our @EXPORT_OK = qw/ f_Optim_NSGAII /; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head1 DESCRIPTION |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 Reference |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
NSGAII.pm apply (with some variations) the NSGA-II algorithm described in the paper: |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
A Fast and Elitist Multiobjective Genetic Algorithm:NSGA-II |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=over |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Kalyanmoy Deb, Associate Member, IEEE, Amrit Pratap, Sameer Agarwal, and T. Meyarivan |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=back |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=head2 Objective |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
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. |
181
|
|
|
|
|
|
|
In the Pareto front no solution is better than the others because each solution is a trade-off. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head2 Function to optimize |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
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) |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head2 Features |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
The optimization is done: |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=over 3 |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item * considering allowed B |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item * considering optional B (x1^2 + sqrt(x2) -x3 >= 0 , ...) |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item * with a B of the subroutine to optimize (and so of individuals) in each generation, by using perl fork() function |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=back |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
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. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
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: |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=over |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item * run on your pc if you run the computation locally (e.g. 4) |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item * run on a remote server if you run (inside the C) the computation there (e.g. 32) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=back |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
C should be multiple of C, to optimize resources use, but it is not necessary. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Problems with this modules are expected on systems not supporting fork() perl function. |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
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). |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Each time a new generation finish, all information of the population are written in the C directory: |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=over |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item * F: input (parameters values) |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item * F: output (corresponding functions values) |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=back |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
The algorithm can start by default with a random initial population (satisfying the bounds) or the B can be assigned by assigning it to the C option. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Assigning the population at the start can be useful for example if: |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=over |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item * there was an unexpected termination of the program during the optimization, so that one can restart by using the content of one of the last saved F |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item * there is the interest in continuing the optimization with different parameters |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item * there is already an idea of some input parameters which could give a good output |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=back |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
For an example of use see F. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 Mutation |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
The implementation of the B part has been done in a B. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
In particular B are applied in sequence: |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=over |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item 1) mutation of all the input parameters (the genes), but only on a certain percentage C of the population: |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
-> 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). |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=item 2) mutation of all the individuals of the population, but only on a certain percentage C of the input parameters (the genes) |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
-> Random change (inside the permitted bounds) |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=back |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head2 Verification |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
This module has been tested, successfully, on many of the test problems defined in the paper described in the Reference section (see EXAMPLE section) |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
The performance (convergence for same population number and max generation number) seems to be comparable to that described in that paper. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=head1 EXAMPLE |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
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, ...). |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
Here you see the B problem with: |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=over |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=item * two input parameters $x->[0] and $x->[1] |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=item * two output functions to optimize f1 and f2 |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=item * two constraining equations between the input parameters |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=item * 8 process in parallel (8 subroutine f_CONTRS are evaluated in parallel as indipendent processes) |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=back |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
use Optimization::NSGAII qw/ f_Optim_NSGAII /; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# function to minimize |
295
|
|
|
|
|
|
|
sub f_CONSTR { |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
my $x = shift; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
my $n = scalar(@$x); |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
my $f1 = $x->[0]; |
302
|
|
|
|
|
|
|
my $f2 = (1 + $x->[1])/$x->[0]; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my $out = [$f1,$f2]; |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
return $out; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# inequality constraints set |
310
|
|
|
|
|
|
|
sub f_inequality { |
311
|
|
|
|
|
|
|
my $x =shift; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# equation >= 0 |
314
|
|
|
|
|
|
|
my @ineq = |
315
|
|
|
|
|
|
|
( |
316
|
|
|
|
|
|
|
$x->[1] + 9*$x->[0] - 6 , |
317
|
|
|
|
|
|
|
-$x->[1] + 9*$x->[0] -1 |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
return \@ineq; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
my $bounds = [[0.1,1],[0,5]]; |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
my $ref_input_output = f_Optim_NSGAII( |
326
|
|
|
|
|
|
|
{ |
327
|
|
|
|
|
|
|
'nPop' => 50, |
328
|
|
|
|
|
|
|
'nGen' => 100, |
329
|
|
|
|
|
|
|
'bounds' => $bounds, |
330
|
|
|
|
|
|
|
'function' => \&f_CONSTR, |
331
|
|
|
|
|
|
|
'f_ineq' => \&f_inequality, |
332
|
|
|
|
|
|
|
'nProc' => 8, |
333
|
|
|
|
|
|
|
'filesDir' => '/tmp', |
334
|
|
|
|
|
|
|
'verboseFinal' => 1, |
335
|
|
|
|
|
|
|
'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], |
336
|
|
|
|
|
|
|
'scaleDistrib' => 0.05, |
337
|
|
|
|
|
|
|
'percentMut' => 5, |
338
|
|
|
|
|
|
|
}, |
339
|
|
|
|
|
|
|
{ |
340
|
|
|
|
|
|
|
'dx' => 100, |
341
|
|
|
|
|
|
|
'dy' => 40, |
342
|
|
|
|
|
|
|
'xlabel' => 'stiffness [N/mm]', |
343
|
|
|
|
|
|
|
'ylabel' => 'mass [kg]', |
344
|
|
|
|
|
|
|
'xlim' => [0.1,1], |
345
|
|
|
|
|
|
|
'ylim' => [0,10], |
346
|
|
|
|
|
|
|
'nfun' => [0,1], |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head1 OUTPUT PREVIEW |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
This below is a typical output of the final Pareto front (problem TNK). |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
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. |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
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) |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
The points will also expand to occupy the entire front. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
GENERATION 250 |
364
|
|
|
|
|
|
|
m| |
365
|
|
|
|
|
|
|
a| |
366
|
|
|
|
|
|
|
s| |
367
|
|
|
|
|
|
|
s| |
368
|
|
|
|
|
|
|
| |
369
|
|
|
|
|
|
|
[| |
370
|
|
|
|
|
|
|
k| |
371
|
|
|
|
|
|
|
g| 1 |
372
|
|
|
|
|
|
|
]| 11 |
373
|
|
|
|
|
|
|
| 11 |
374
|
|
|
|
|
|
|
| 1 1 |
375
|
|
|
|
|
|
|
| 11 |
376
|
|
|
|
|
|
|
| 1 |
377
|
|
|
|
|
|
|
| 11 1 1 1 1 |
378
|
|
|
|
|
|
|
| 1 |
379
|
|
|
|
|
|
|
| 1 |
380
|
|
|
|
|
|
|
| |
381
|
|
|
|
|
|
|
| 1 |
382
|
|
|
|
|
|
|
| 1 1 |
383
|
|
|
|
|
|
|
| 1111 |
384
|
|
|
|
|
|
|
| 1 |
385
|
|
|
|
|
|
|
| |
386
|
|
|
|
|
|
|
| |
387
|
|
|
|
|
|
|
| |
388
|
|
|
|
|
|
|
| |
389
|
|
|
|
|
|
|
| 1 |
390
|
|
|
|
|
|
|
| 11 |
391
|
|
|
|
|
|
|
| 1 |
392
|
|
|
|
|
|
|
| 1 |
393
|
|
|
|
|
|
|
| |
394
|
|
|
|
|
|
|
|______________________________________________________________________ |
395
|
|
|
|
|
|
|
stiffness [N/mm] |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head1 INSTALLATION |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
Following the instruction in perlmodinstall: |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=over |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=item * download the F |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=item * decompress and unpack |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=over |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item * C |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item * C |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=back |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=item * C |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=item * C |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
=item * C |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=item * C |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item * C |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
to install it locally use this instead of C: |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
C if you want to install it in /my/folder |
431
|
|
|
|
|
|
|
then you will have to use in your script: C |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=back |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head1 AUTHOR |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Dario Rubino, C<< >> |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head1 BUGS |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Solutions (input-output pairs) often contain duplicates, this would require some investigation. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Please report any bugs to C, or through |
451
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
452
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=head1 SUPPORT |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
perldoc Optimization::NSGAII |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
You can also look for information at: |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=over 4 |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
L |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=item * CPAN Ratings |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
L |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=item * Search CPAN |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
L |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
=back |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
This software is Copyright (c) 2022 by Dario Rubino. |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
This is free software, licensed under: |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
The Artistic License 2.0 (GPL Compatible) |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
=cut |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# A point in the population is defined by: |
493
|
|
|
|
|
|
|
# - input values for the objective functions (input parameters) -> contained in the reference VP |
494
|
|
|
|
|
|
|
# - correspondent output population (objective function values) -> contained in the reference P |
495
|
|
|
|
|
|
|
# |
496
|
|
|
|
|
|
|
# P is the most important set of values used in this package, because the objective functions' values lead the algorithm |
497
|
|
|
|
|
|
|
# VP elements then are postprocessed accordingly so that P and VP maintain always a one to one index correspondence |
498
|
|
|
|
|
|
|
# |
499
|
|
|
|
|
|
|
# VARIABLES |
500
|
|
|
|
|
|
|
# |
501
|
|
|
|
|
|
|
# VP: input values for each population's point |
502
|
|
|
|
|
|
|
# : [[x11,x12,...x1D],...] |
503
|
|
|
|
|
|
|
# P : population (objective values for each point) |
504
|
|
|
|
|
|
|
# : [[fun11,fun12,..fun1M],..] |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# D : number of dimension of the problem (how many input values for a point) |
507
|
|
|
|
|
|
|
# N : size of population P |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
# p,q : index of a single solution of the population |
510
|
|
|
|
|
|
|
# : id_sol_ith |
511
|
|
|
|
|
|
|
# Sp: set of solution dominated by p (worse than p) for each point |
512
|
|
|
|
|
|
|
# : [[id_sol_i,id_sol_j,...],..] |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# np: number of solutions which dominate p (better than p), np = zero for first front solutions |
515
|
|
|
|
|
|
|
# : [np1,np2,..] |
516
|
|
|
|
|
|
|
# F: set of solution in front ith |
517
|
|
|
|
|
|
|
# : [[id_sol_k,id_sol_t,...],...] |
518
|
|
|
|
|
|
|
# rank : rank of each solution = front number , rank = 1 for first front solutions |
519
|
|
|
|
|
|
|
# : [rank1,rank2...rankN]; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
######################################################################################################## |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
my @out_print; |
524
|
|
|
|
|
|
|
my $inf = 1e9; |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
sub f_ineq2maxerr { |
527
|
|
|
|
|
|
|
# max error calculation in inequalities |
528
|
|
|
|
|
|
|
# input: lhs inequalities ref (errors) |
529
|
|
|
|
|
|
|
# output: max error |
530
|
4378864
|
|
|
4378864
|
0
|
4749469
|
my $ref_ineq = shift; |
531
|
|
|
|
|
|
|
|
532
|
4378864
|
|
|
|
|
4550783
|
my @ineq = @{$ref_ineq}; |
|
4378864
|
|
|
|
|
5477849
|
|
533
|
|
|
|
|
|
|
|
534
|
4378864
|
|
|
|
|
4648556
|
my $err = 0; |
535
|
4378864
|
|
|
|
|
5112263
|
foreach my $el(@ineq){ |
536
|
4378864
|
|
|
|
|
6779400
|
$err = max( $err, -$el); |
537
|
|
|
|
|
|
|
} |
538
|
4378864
|
|
|
|
|
6023196
|
return $err; |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
sub f_fast_non_dominated_sort { |
543
|
|
|
|
|
|
|
# reference to population |
544
|
121
|
|
|
121
|
0
|
1021
|
my $P = shift; |
545
|
121
|
|
|
|
|
545
|
my $VP = shift; |
546
|
121
|
|
|
|
|
613
|
my $f_ineq = shift; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
549
|
121
|
|
|
|
|
701
|
my $Sp; |
550
|
|
|
|
|
|
|
my $np; |
551
|
121
|
|
|
|
|
0
|
my $F; |
552
|
121
|
|
|
|
|
0
|
my $rank; |
553
|
|
|
|
|
|
|
|
554
|
121
|
|
|
|
|
216
|
my $N = scalar(@{$P}); |
|
121
|
|
|
|
|
430
|
|
555
|
|
|
|
|
|
|
|
556
|
121
|
|
|
|
|
1209
|
foreach my $p(0..$N-1){ |
557
|
12100
|
|
|
|
|
19981
|
$np->[$p] = 0; |
558
|
12100
|
|
|
|
|
21941
|
foreach my $q(0..$N-1){ |
559
|
1210000
|
100
|
|
|
|
1665657
|
next if $p == $q; # max error <-- inequalities <-- input pars |
560
|
1197900
|
100
|
|
|
|
1513338
|
if ( f_dominates($P->[$p],$P->[$q], f_ineq2maxerr( &{$f_ineq}($VP->[$p]) ), f_ineq2maxerr( &{$f_ineq}($VP->[$q])) ) ){ |
|
1197900
|
100
|
|
|
|
1523269
|
|
|
1197900
|
|
|
|
|
1499479
|
|
561
|
206368
|
|
|
|
|
213241
|
push @{$Sp->[$p]}, $q; |
|
206368
|
|
|
|
|
443244
|
|
562
|
|
|
|
|
|
|
} |
563
|
991532
|
|
|
|
|
1279083
|
elsif ( f_dominates($P->[$q],$P->[$p], f_ineq2maxerr( &{$f_ineq}($VP->[$q]) ), f_ineq2maxerr( &{$f_ineq}($VP->[$p])) ) ){ |
|
991532
|
|
|
|
|
1262192
|
|
564
|
202554
|
|
|
|
|
378515
|
$np->[$p] += 1; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
12100
|
100
|
|
|
|
27161
|
if ($np->[$p] == 0){ |
568
|
3039
|
|
|
|
|
6905
|
$rank->[$p]=1; # front number, 1 = best |
569
|
3039
|
|
|
|
|
5483
|
push @{$F->[0]}, $p; |
|
3039
|
|
|
|
|
7249
|
|
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# all other fronts |
574
|
121
|
|
|
|
|
260
|
my $i = 0; |
575
|
|
|
|
|
|
|
|
576
|
121
|
|
|
|
|
512
|
while (scalar(@{$F->[$i]})){ |
|
1596
|
|
|
|
|
3914
|
|
577
|
1475
|
|
|
|
|
1962
|
my @Q;# members of next front |
578
|
|
|
|
|
|
|
|
579
|
1475
|
|
|
|
|
1801
|
foreach my $p(@{$F->[$i]}){ |
|
1475
|
|
|
|
|
2533
|
|
580
|
12100
|
|
|
|
|
12427
|
foreach my $q(@{$Sp->[$p]}){ |
|
12100
|
|
|
|
|
20760
|
|
581
|
206368
|
|
|
|
|
217689
|
$np->[$q] -=1; |
582
|
206368
|
100
|
|
|
|
306340
|
if ($np->[$q] == 0){ |
583
|
9061
|
|
|
|
|
10579
|
$rank->[$q] = $i + 1 + 1; |
584
|
9061
|
|
|
|
|
12461
|
push @Q, $q; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
1475
|
|
|
|
|
1526
|
$i++; |
589
|
1475
|
|
|
|
|
3959
|
$F->[$i] = [@Q]; |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
121
|
|
|
|
|
470
|
for my $p(0..$N-1){ |
594
|
12100
|
|
|
|
|
14255
|
push @out_print, join(' ',($rank->[$p],@{$P->[$p]})); |
|
12100
|
|
|
|
|
30894
|
|
595
|
|
|
|
|
|
|
} |
596
|
|
|
|
|
|
|
|
597
|
121
|
|
|
|
|
6246
|
return ($rank,$F); # rank for each point, points in each front |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
######################################################################################################## |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
sub f_dominates { |
604
|
|
|
|
|
|
|
# input: two elements of P |
605
|
|
|
|
|
|
|
# output: 1 if P1 dominate P2, 0 otherwise |
606
|
|
|
|
|
|
|
|
607
|
2189432
|
|
|
2189432
|
0
|
2414482
|
my $P1 = shift; |
608
|
2189432
|
|
|
|
|
2209615
|
my $P2 = shift; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# constraints errors |
611
|
2189432
|
|
|
|
|
2263503
|
my $err1 = shift; |
612
|
2189432
|
|
|
|
|
2225305
|
my $err2 = shift; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# number of objective (dimensions) |
616
|
2189432
|
|
|
|
|
2224162
|
my $M = scalar(@{$P1}); |
|
2189432
|
|
|
|
|
2306764
|
|
617
|
|
|
|
|
|
|
|
618
|
2189432
|
|
|
|
|
2303929
|
my $P1_dominate_P2_count = 0; |
619
|
|
|
|
|
|
|
|
620
|
2189432
|
|
|
|
|
2923832
|
for my $kM(0..$M-1){ |
621
|
4378864
|
100
|
|
|
|
6765582
|
if ($P1->[$kM] <= $P2->[$kM]){ |
622
|
2395800
|
|
|
|
|
2784693
|
$P1_dominate_P2_count++; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
2189432
|
|
|
|
|
2251784
|
my $P1_dominate_P2_p; |
627
|
|
|
|
|
|
|
# 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 |
628
|
|
|
|
|
|
|
# else simply 1 doesn't dominate 2 |
629
|
2189432
|
100
|
66
|
|
|
5957566
|
if ( |
|
|
|
66
|
|
|
|
|
630
|
|
|
|
|
|
|
$err1 < $err2 |
631
|
|
|
|
|
|
|
|| |
632
|
|
|
|
|
|
|
($err1 == $err2 && $P1_dominate_P2_count == $M) |
633
|
|
|
|
|
|
|
){ |
634
|
408922
|
|
|
|
|
450548
|
$P1_dominate_P2_p = 1; |
635
|
|
|
|
|
|
|
} |
636
|
1780510
|
|
|
|
|
1984476
|
else { $P1_dominate_P2_p = 0} |
637
|
|
|
|
|
|
|
|
638
|
2189432
|
|
|
|
|
4061422
|
return $P1_dominate_P2_p; |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
######################################################################################################## |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
sub f_crowding_distance_assignment{ |
645
|
|
|
|
|
|
|
# input: ref of array of a subset of population P, population P |
646
|
|
|
|
|
|
|
# output: distance value for each point of this set |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
# global ids of the set of non dominated points of interest |
649
|
562
|
|
|
562
|
0
|
685
|
my $ids = shift; |
650
|
|
|
|
|
|
|
# objectives of all points |
651
|
562
|
|
|
|
|
653
|
my $P = shift; |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
# build the set of objectives for these global ids (I is a subset of P) |
654
|
562
|
|
|
|
|
1275
|
my $I = [@{$P}[@{$ids}]]; |
|
562
|
|
|
|
|
1610
|
|
|
562
|
|
|
|
|
744
|
|
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
# initialize distance |
657
|
562
|
|
|
|
|
755
|
my $Dist; |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
# number of objective (dimensions) |
660
|
562
|
|
|
|
|
746
|
my $M = scalar(@{$P->[0]}); |
|
562
|
|
|
|
|
739
|
|
661
|
|
|
|
|
|
|
# number of points in I |
662
|
562
|
|
|
|
|
626
|
my $n = scalar(@{$ids}); |
|
562
|
|
|
|
|
657
|
|
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
# for each objective |
665
|
562
|
|
|
|
|
1608
|
for my $kM(0..$M-1){ |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# local id of the points, sorted by objective |
668
|
1124
|
|
|
|
|
5054
|
my @index_sort = sort{$I->[$a][$kM] <=> $I->[$b][$kM]} 0..($n-1); |
|
43776
|
|
|
|
|
51609
|
|
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
# min & max for this objective |
671
|
1124
|
|
|
|
|
2214
|
my $fmin = $I->[$index_sort[0]][$kM]; |
672
|
1124
|
|
|
|
|
1542
|
my $fmax = $I->[$index_sort[-1]][$kM]; |
673
|
|
|
|
|
|
|
|
674
|
1124
|
50
|
|
|
|
1980
|
if ($fmax-$fmin<0.00001){$fmax += 0.00001} |
|
0
|
|
|
|
|
0
|
|
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
# build the distance |
677
|
1124
|
|
|
|
|
2004
|
$Dist->[$index_sort[0]] = $inf; |
678
|
1124
|
|
|
|
|
1787
|
$Dist->[$index_sort[-1]] = $inf; |
679
|
|
|
|
|
|
|
# and for all other intermediate point |
680
|
1124
|
|
|
|
|
2010
|
for my $i(1..($n-2)){ |
681
|
12510
|
|
|
|
|
21104
|
$Dist->[$index_sort[$i]] += ($I->[$index_sort[$i+1]][$kM] - $I->[$index_sort[$i-1]][$kM])/($fmax-$fmin); |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
# return distances for each point, $Dist->[ith] is distance for point $ids->[ith] |
686
|
562
|
|
|
|
|
1171
|
return $Dist; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
######################################################################################################## |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
sub f_crowding_distance_operator { |
692
|
|
|
|
|
|
|
# input: rank and distance of two element of the population (selected by GA) |
693
|
|
|
|
|
|
|
# output: 1 if first dominate second, else 0 |
694
|
|
|
|
|
|
|
|
695
|
12100
|
|
|
12100
|
0
|
13012
|
my $rank = shift; |
696
|
12100
|
|
|
|
|
12493
|
my $Dist = shift; |
697
|
|
|
|
|
|
|
|
698
|
12100
|
|
|
|
|
12295
|
my $P1_dominate_P2_p; |
699
|
|
|
|
|
|
|
|
700
|
12100
|
100
|
100
|
|
|
31481
|
if ( |
|
|
|
100
|
|
|
|
|
701
|
|
|
|
|
|
|
$rank->[0] < $rank->[1] |
702
|
|
|
|
|
|
|
|| |
703
|
|
|
|
|
|
|
($rank->[0] == $rank->[1]) && ($Dist->[0] > $Dist->[1]) |
704
|
|
|
|
|
|
|
){ |
705
|
5601
|
|
|
|
|
6239
|
$P1_dominate_P2_p = 1 |
706
|
|
|
|
|
|
|
} |
707
|
6499
|
|
|
|
|
7374
|
else {$P1_dominate_P2_p = 0} |
708
|
12100
|
|
|
|
|
15362
|
return $P1_dominate_P2_p; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
######################################################################################################## |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
sub f_NSGAII { |
714
|
|
|
|
|
|
|
# input: current function input values VP(t) & VQ(t) ( VQ is obtained by GA) |
715
|
|
|
|
|
|
|
# current population Pt & Qt (obtained by evaluating objective function using VPt & VQt) |
716
|
|
|
|
|
|
|
# output: VP(t+1), P(t+1), rank & distance for each point of this new population |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
# input variables' values |
719
|
121
|
|
|
121
|
0
|
1015
|
my $VPt = shift; |
720
|
121
|
|
|
|
|
878
|
my $VQt = shift; |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
# population (objective function values) |
723
|
121
|
|
|
|
|
455
|
my $Pt = shift; |
724
|
121
|
|
|
|
|
328
|
my $Qt = shift; |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
# constraints function |
727
|
121
|
|
|
|
|
798
|
my $f_ineq = shift; |
728
|
|
|
|
|
|
|
|
729
|
121
|
|
|
|
|
11497
|
my $Rt = [(@$Pt,@$Qt)]; |
730
|
121
|
|
|
|
|
18594
|
my $VRt = [(@$VPt,@$VQt)]; |
731
|
121
|
|
|
|
|
895
|
my $N = scalar(@$Pt); |
732
|
|
|
|
|
|
|
|
733
|
121
|
|
|
|
|
1258
|
my ($temp,$F) = f_fast_non_dominated_sort($Rt,$VRt,$f_ineq); |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# input variables for the new population P_t+1 |
736
|
121
|
|
|
|
|
336
|
my $VPtp1=[]; |
737
|
|
|
|
|
|
|
# new population |
738
|
121
|
|
|
|
|
223
|
my $Ptp1=[]; |
739
|
121
|
|
|
|
|
230
|
my $Dist=[]; |
740
|
121
|
|
|
|
|
243
|
my $rank=[]; |
741
|
|
|
|
|
|
|
|
742
|
121
|
|
|
|
|
198
|
my $i=0; |
743
|
|
|
|
|
|
|
# push the best fronts in final population & store crowding distance |
744
|
121
|
|
|
|
|
196
|
while ( scalar(@{$Ptp1}) + scalar(@{$F->[$i]}) <= $N ){ |
|
562
|
|
|
|
|
660
|
|
|
562
|
|
|
|
|
1414
|
|
745
|
441
|
|
|
|
|
686
|
push @$Ptp1, @$Rt[@{$F->[$i]}]; |
|
441
|
|
|
|
|
1351
|
|
746
|
441
|
|
|
|
|
671
|
push @$VPtp1,@$VRt[@{$F->[$i]}]; |
|
441
|
|
|
|
|
1611
|
|
747
|
441
|
|
|
|
|
859
|
my $Dist_ = f_crowding_distance_assignment($F->[$i],$Rt); |
748
|
441
|
|
|
|
|
1367
|
push @$rank, ($i+1) x @$Dist_; |
749
|
441
|
|
|
|
|
1062
|
push @$Dist, @$Dist_; |
750
|
441
|
|
|
|
|
762
|
$i++; |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
# only part of the following front will be pushed in final population, sorting by crowding |
754
|
|
|
|
|
|
|
# here rank is the same for all points, so the crowded-comparison operators reduce to a comparison of crowding distance |
755
|
121
|
|
|
|
|
401
|
my $Dist_ = f_crowding_distance_assignment($F->[$i],$Rt); |
756
|
|
|
|
|
|
|
|
757
|
121
|
|
|
|
|
269
|
my $nf = scalar(@{$F->[$i]}); |
|
121
|
|
|
|
|
639
|
|
758
|
|
|
|
|
|
|
|
759
|
121
|
|
|
|
|
493
|
my @index_sort = sort{$Dist_->[$b] <=> $Dist_->[$a]} 0..($nf-1); |
|
9008
|
|
|
|
|
10987
|
|
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
# cut to fill only the remaining part of Ptp1 |
762
|
121
|
|
|
|
|
676
|
@index_sort = @index_sort[0..(($N-scalar(@$Ptp1))-1)]; |
763
|
|
|
|
|
|
|
|
764
|
121
|
|
|
|
|
776
|
push @$Ptp1, @$Rt[@{$F->[$i]}[@index_sort]]; |
|
121
|
|
|
|
|
531
|
|
765
|
121
|
|
|
|
|
279
|
push @$VPtp1, @$VRt[@{$F->[$i]}[@index_sort]]; |
|
121
|
|
|
|
|
577
|
|
766
|
121
|
|
|
|
|
827
|
push @$rank, ($i+1) x @index_sort; |
767
|
121
|
|
|
|
|
699
|
push @$Dist, @$Dist_[@index_sort]; |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
|
770
|
121
|
|
|
|
|
3086
|
return $VPtp1,$Ptp1,$rank,$Dist; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
} |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
######################################################################################################## |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
sub f_SBX { |
777
|
6050
|
|
|
6050
|
0
|
6405
|
my $contiguity = shift; # >0 (usually between 2 and 5), greater value produces child values similar to those of the parents |
778
|
6050
|
|
|
|
|
6234
|
my $VP1_ = shift; # input values of parent 1 (ref) |
779
|
6050
|
|
|
|
|
6217
|
my $VP2_ = shift; # input values of parent 2 (ref) |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
# array of equal length |
782
|
6050
|
|
|
|
|
8828
|
my @VP1 = @$VP1_; |
783
|
6050
|
|
|
|
|
7640
|
my @VP2 = @$VP2_; |
784
|
6050
|
|
|
|
|
6104
|
my @out; |
785
|
|
|
|
|
|
|
|
786
|
6050
|
|
|
|
|
9165
|
for my $kp(0..$#VP1){ |
787
|
|
|
|
|
|
|
# for array of length=1 or rand<0.5 the cross is made |
788
|
18150
|
100
|
66
|
|
|
42831
|
if ( $#VP1 == 0 || rand(1)<0.5){ |
789
|
|
|
|
|
|
|
|
790
|
8910
|
|
|
|
|
10725
|
my $u = rand(1); |
791
|
|
|
|
|
|
|
|
792
|
8910
|
|
|
|
|
11767
|
my $exponent = (1/($contiguity+1)); |
793
|
8910
|
100
|
|
|
|
19181
|
my $beta = ($u < 0.5)? (2*$u)**$exponent : (0.5/(1-$u))**$exponent; |
794
|
|
|
|
|
|
|
|
795
|
8910
|
100
|
|
|
|
12631
|
my $sign = (rand(1) < 0.5)? -1 : 1; |
796
|
8910
|
|
|
|
|
19668
|
$out[$kp] = (($VP1[$kp] + $VP2[$kp])/2) + $sign * $beta*0.5*abs($VP1[$kp] - $VP2[$kp]) |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
} |
799
|
|
|
|
|
|
|
else { |
800
|
9240
|
|
|
|
|
14044
|
$out[$kp] = $VP1[$kp] |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
} |
803
|
6050
|
|
|
|
|
9696
|
return \@out; |
804
|
|
|
|
|
|
|
} |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
######################################################################################################## |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
sub f_GA { |
809
|
|
|
|
|
|
|
# input: input values, rank and Dist of the population P(t+1) |
810
|
|
|
|
|
|
|
# output: input value of the population Q(t+1) |
811
|
|
|
|
|
|
|
|
812
|
121
|
|
|
121
|
0
|
287
|
my $VPtp1 = shift; |
813
|
121
|
|
|
|
|
285
|
my $rank = shift; |
814
|
121
|
|
|
|
|
166
|
my $Dist = shift; |
815
|
121
|
|
|
|
|
199
|
my $contiguity = shift; |
816
|
|
|
|
|
|
|
|
817
|
121
|
|
|
|
|
208
|
my $bounds = shift; # for mutation |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
# optional paramters for mutation: |
820
|
121
|
|
|
|
|
215
|
my $distrib = shift; |
821
|
121
|
|
|
|
|
187
|
my $scaleDistrib = shift; |
822
|
121
|
|
|
|
|
187
|
my $percentMut =shift; |
823
|
|
|
|
|
|
|
|
824
|
121
|
|
|
|
|
172
|
my $VQtp1 = []; |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
# binary tournament |
827
|
|
|
|
|
|
|
# two random element are compared |
828
|
|
|
|
|
|
|
# the best according crowding distance operator is selected as parent 1 |
829
|
|
|
|
|
|
|
# the same for selecting parent 2 |
830
|
|
|
|
|
|
|
# parent 1 and 2 are crossed with SBX to give a child |
831
|
|
|
|
|
|
|
# the procedure is repeated to fill Q(t+1) |
832
|
|
|
|
|
|
|
|
833
|
121
|
|
|
|
|
312
|
my $N = scalar(@$VPtp1); |
834
|
|
|
|
|
|
|
|
835
|
121
|
|
|
|
|
922
|
for my $kt(0..$N-1){ |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
# selection of the two parent |
838
|
6050
|
|
|
|
|
6653
|
my @index_parent; |
839
|
6050
|
|
|
|
|
7683
|
for (1..2){ |
840
|
12100
|
|
|
|
|
20036
|
my ($r1,$r2) = (int(rand($N)),int(rand($N))); |
841
|
12100
|
|
|
|
|
24360
|
my $P1_dominate_P2_p = f_crowding_distance_operator( [$rank->[$r1],$rank->[$r2]] , [$Dist->[$r1],$Dist->[$r2]] ); |
842
|
|
|
|
|
|
|
|
843
|
12100
|
100
|
|
|
|
19318
|
if ($P1_dominate_P2_p == 1){push @index_parent, $r1} |
|
5601
|
|
|
|
|
7790
|
|
844
|
6499
|
|
|
|
|
8874
|
else {push @index_parent, $r2} |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
# crossover of the two parent |
847
|
6050
|
|
|
|
|
9268
|
my $out = f_SBX( $contiguity , $VPtp1->[$index_parent[0]] , $VPtp1->[$index_parent[1]] ); |
848
|
6050
|
|
|
|
|
9346
|
push @$VQtp1, $out; |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
# mutation 1 |
852
|
|
|
|
|
|
|
# perturbation using distribution array |
853
|
121
|
|
|
|
|
391
|
for my $k(0..(scalar(@$VQtp1) - 1)){ |
854
|
|
|
|
|
|
|
# $percentMut percentage of individuals are changed in all their elements (all input parameter will be perturbated) |
855
|
6050
|
100
|
|
|
|
10400
|
if (rand(1)> 1-$percentMut/100){ |
856
|
466
|
|
|
|
|
576
|
for my $d(0..(scalar(@{$VQtp1->[0]}) - 1)){ |
|
466
|
|
|
|
|
1043
|
|
857
|
|
|
|
|
|
|
# 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 |
858
|
1398
|
|
|
|
|
3675
|
$VQtp1->[$k][$d] += ($bounds->[$d][1] - $bounds->[$d][0]) * $scaleDistrib * $distrib->[int(rand(scalar(@$distrib)))]; |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
} |
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
# mutation 2 |
864
|
|
|
|
|
|
|
# 100% probability of mutation inside VQ(t+1), so the intention is to act on all individual of the population |
865
|
121
|
|
|
|
|
1412
|
for my $k(0..int((scalar(@$VQtp1) - 1) * 100/100)){ |
866
|
6050
|
|
|
|
|
6385
|
for my $d(0..(scalar(@{$VQtp1->[0]}) - 1)){ |
|
6050
|
|
|
|
|
7859
|
|
867
|
|
|
|
|
|
|
# $percentMut percentage of values are changed inside each single individual, value is inside bounds |
868
|
18150
|
100
|
|
|
|
28587
|
if (rand(1)> 1-$percentMut/100){ |
869
|
860
|
|
|
|
|
1806
|
$VQtp1->[$k][$d] = rand(1) * ($bounds->[$d][1] - $bounds->[$d][0]) + $bounds->[$d][0]; |
870
|
|
|
|
|
|
|
} |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
121
|
|
|
|
|
474
|
return $VQtp1; |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
sub f_Optim_NSGAII { |
881
|
|
|
|
|
|
|
|
882
|
23
|
|
|
23
|
1
|
6187
|
my $par = shift; |
883
|
|
|
|
|
|
|
|
884
|
23
|
|
|
|
|
46
|
my $par_plot = shift; |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
|
888
|
23
|
|
|
|
|
46
|
my %par = %{$par}; |
|
23
|
|
|
|
|
115
|
|
889
|
|
|
|
|
|
|
|
890
|
23
|
|
|
|
|
46
|
my $nPop = $par{'nPop'}; |
891
|
23
|
|
|
|
|
46
|
my $nGen = $par{'nGen'}; |
892
|
|
|
|
|
|
|
|
893
|
23
|
|
|
|
|
46
|
my $bounds = $par{'bounds'}; |
894
|
23
|
|
|
|
|
46
|
my $n = scalar @$bounds; |
895
|
|
|
|
|
|
|
|
896
|
23
|
|
|
|
|
23
|
my $fun = $par{'function'}; |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
# optional paramters: |
899
|
|
|
|
|
|
|
|
900
|
23
|
|
50
|
4378864
|
|
207
|
my $f_ineq = $par{'f_ineq'} // sub {return [0]}; |
|
4378864
|
|
|
|
|
6278484
|
|
901
|
|
|
|
|
|
|
|
902
|
23
|
|
50
|
|
|
69
|
my $verboseFinal = $par{'verboseFinal'} // 1; |
903
|
|
|
|
|
|
|
|
904
|
23
|
|
50
|
|
|
69
|
my $distrib = $par{'distrib'} // [-1,-0.5,0,0.5,1]; # for mutation, default [-1,-0.5,0,0.5,1] |
905
|
23
|
|
50
|
|
|
92
|
my $scaleDistrib = $par{'scaleDistrib'} // 0; # for mutation, default = 0, no perturbation |
906
|
23
|
|
50
|
|
|
69
|
my $percentMut = $par{'percentMut'} // 5; # for mutation, default = 5% |
907
|
|
|
|
|
|
|
|
908
|
23
|
|
50
|
|
|
115
|
my $startPop = $par{'startPop'} // 'nostartPop'; |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# control for no wrong use of keys |
911
|
23
|
|
|
|
|
92
|
my @keys_ok = ('nPop','nGen','bounds','function','nProc','filesDir','verboseFinal','f_ineq','distrib','scaleDistrib','percentMut','startPop'); |
912
|
23
|
|
|
|
|
322
|
for my $key(keys %par){ |
913
|
207
|
50
|
|
|
|
2714
|
unless ( grep( /^$key$/, @keys_ok ) ) { |
914
|
0
|
|
|
|
|
0
|
die 'E R R O R : the use of "'.$key.'" in the function to optimize is not defined! Compare with documentation.'; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
} |
917
|
|
|
|
|
|
|
|
918
|
23
|
|
|
|
|
69
|
my $VPt; |
919
|
|
|
|
|
|
|
my $VQt; |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
|
922
|
23
|
|
|
|
|
92
|
for my $gen(0..$nGen){ |
923
|
143
|
100
|
|
|
|
582
|
if ($gen == 0){ |
924
|
|
|
|
|
|
|
# input |
925
|
23
|
|
|
|
|
46
|
for (0..$nPop-1){ |
926
|
1150
|
50
|
|
|
|
1610
|
if ($startPop eq 'nostartPop'){ |
927
|
1150
|
|
|
|
|
1495
|
$VPt->[$_]=[map { rand(1) * ($bounds->[$_-1][1] - $bounds->[$_-1][0]) + $bounds->[$_-1][0] } 1..$n]; |
|
3450
|
|
|
|
|
7636
|
|
928
|
|
|
|
|
|
|
} |
929
|
|
|
|
|
|
|
else { |
930
|
0
|
|
|
|
|
0
|
$VPt = $startPop; |
931
|
|
|
|
|
|
|
} |
932
|
1150
|
|
|
|
|
1633
|
$VQt->[$_]=[map { rand(1) * ($bounds->[$_-1][1] - $bounds->[$_-1][0]) + $bounds->[$_-1][0] } 1..$n]; |
|
3450
|
|
|
|
|
6716
|
|
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
|
943
|
143
|
|
|
|
|
474
|
my $nProc = $par{'nProc'}; |
944
|
143
|
|
|
|
|
338
|
my $filesDir = $par{'filesDir'}; |
945
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
# if ($nPop%$nProc != 0){warn "\n nPop should be divisible by nProc!\n\n"}; |
947
|
|
|
|
|
|
|
|
948
|
143
|
|
|
|
|
184
|
my $fork = 0; |
949
|
|
|
|
|
|
|
|
950
|
143
|
|
|
|
|
582
|
for (1..$nProc){ |
951
|
|
|
|
|
|
|
|
952
|
275
|
|
|
|
|
223336
|
my $pid = fork; |
953
|
275
|
50
|
|
|
|
6635
|
die $! unless defined $pid; |
954
|
275
|
|
|
|
|
2139
|
$fork++; |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
# say "in PID = $$ with child PID = $pid fork# = $fork"; |
957
|
|
|
|
|
|
|
# parent process stop here, child processes go on |
958
|
275
|
100
|
|
|
|
6210
|
next if $pid; |
959
|
|
|
|
|
|
|
|
960
|
22
|
|
|
|
|
2032
|
my $r = 0; |
961
|
|
|
|
|
|
|
|
962
|
22
|
|
|
|
|
1418
|
my $nameFileP = $filesDir.'/Pt_'.$fork.'.txt'; |
963
|
22
|
|
|
|
|
918
|
my $nameFileQ = $filesDir.'/Qt_'.$fork.'.txt'; |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
# remove existing input file for this process number |
966
|
22
|
|
|
|
|
80423
|
system ('rm -f '.$nameFileP); |
967
|
22
|
|
|
|
|
67117
|
system ('rm -f '.$nameFileQ); |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
|
970
|
22
|
|
|
|
|
1057
|
my $id_from = ($fork-1)*int($nPop/$nProc); |
971
|
22
|
|
|
|
|
433
|
my $id_to = $fork *int($nPop/$nProc)-1; |
972
|
22
|
100
|
|
|
|
1017
|
if ($fork == $nProc){$id_to = $nPop - 1}; |
|
11
|
|
|
|
|
177
|
|
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
# output |
975
|
22
|
50
|
|
|
|
5730
|
open my $fileoP, '>>', $nameFileP or croak "E R R O R : problem in writing the file ".$nameFileP.' -> "filesDir" path not reachable? -- '; |
976
|
22
|
50
|
|
|
|
2544
|
open my $fileoQ, '>>', $nameFileQ or croak "E R R O R : problem in writing the file ".$nameFileQ.' -> "filesDir" path not reachable? -- '; |
977
|
22
|
|
|
|
|
338
|
for ($id_from .. $id_to){ |
978
|
550
|
|
|
|
|
1227
|
my $Pt_ = &{$fun}($VPt->[$_]); |
|
550
|
|
|
|
|
3249
|
|
979
|
550
|
|
|
|
|
15817
|
my $Qt_ = &{$fun}($VQt->[$_]); |
|
550
|
|
|
|
|
2450
|
|
980
|
550
|
|
|
|
|
12952
|
say $fileoP join ',',@{$Pt_}; |
|
550
|
|
|
|
|
10974
|
|
981
|
550
|
|
|
|
|
989
|
say $fileoQ join ',',@{$Qt_}; |
|
550
|
|
|
|
|
2924
|
|
982
|
|
|
|
|
|
|
} |
983
|
22
|
|
|
|
|
1504
|
close $fileoP; |
984
|
22
|
|
|
|
|
701
|
close $fileoQ; |
985
|
22
|
|
|
|
|
26660
|
exit; |
986
|
|
|
|
|
|
|
} |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
# wait for the processes to finish |
989
|
121
|
|
|
|
|
1468
|
my $kid; |
990
|
121
|
|
|
|
|
537
|
do { |
991
|
363
|
|
|
|
|
43377577
|
$kid = waitpid -1, 0; |
992
|
|
|
|
|
|
|
} while ($kid>0); |
993
|
|
|
|
|
|
|
|
994
|
121
|
|
|
|
|
1039
|
my $Pt; |
995
|
|
|
|
|
|
|
my $Qt; |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# collect data together |
998
|
121
|
|
|
|
|
2557
|
for (1..$nProc){ |
999
|
|
|
|
|
|
|
|
1000
|
242
|
|
|
|
|
4402
|
my $nameFileP = $filesDir.'/Pt_'.$_.'.txt'; |
1001
|
242
|
|
|
|
|
1930
|
my $nameFileQ = $filesDir.'/Qt_'.$_.'.txt'; |
1002
|
242
|
50
|
|
|
|
20203
|
open my $fileiP, '<', $nameFileP or croak "E R R O R : problem in reading the file ".$nameFileP.' -> "filesDir" path not reachable? '; |
1003
|
242
|
50
|
|
|
|
10247
|
open my $fileiQ, '<', $nameFileQ or croak "E R R O R : problem in reading the file ".$nameFileQ.' -> "filesDir" path not reachable? '; |
1004
|
|
|
|
|
|
|
|
1005
|
242
|
|
|
|
|
29781
|
while (my $line = <$fileiP>){ |
1006
|
6050
|
|
|
|
|
8555
|
chomp $line; |
1007
|
6050
|
|
|
|
|
14948
|
my @vals = split ',', $line; |
1008
|
6050
|
|
|
|
|
22409
|
push @$Pt, \@vals; |
1009
|
|
|
|
|
|
|
} |
1010
|
242
|
|
|
|
|
6295
|
while (my $line = <$fileiQ>){ |
1011
|
6050
|
|
|
|
|
9146
|
chomp $line; |
1012
|
6050
|
|
|
|
|
15220
|
my @vals = split ',', $line; |
1013
|
6050
|
|
|
|
|
22247
|
push @$Qt, \@vals; |
1014
|
|
|
|
|
|
|
} |
1015
|
242
|
|
|
|
|
3394
|
close $fileiP; |
1016
|
242
|
|
|
|
|
3331
|
close $fileiQ; |
1017
|
|
|
|
|
|
|
} |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
# new input |
1022
|
121
|
|
|
|
|
2738
|
my ($VPtp1,$Ptp1,$rank,$Dist)=f_NSGAII($VPt,$VQt,$Pt,$Qt,$f_ineq); |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
# save inputs and corresponding outputs at this generation |
1025
|
121
|
|
|
|
|
382
|
my $to_print; |
1026
|
|
|
|
|
|
|
my $FILEO; |
1027
|
|
|
|
|
|
|
# inputs (genes for each individual) |
1028
|
121
|
50
|
|
|
|
21416
|
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? '; |
1029
|
121
|
|
|
|
|
1503
|
$to_print = f_print_columns($VPt,'%25.15f'); |
1030
|
121
|
|
|
|
|
4542
|
print $FILEO (join "\n", @$to_print); |
1031
|
121
|
|
|
|
|
24372
|
close $FILEO; |
1032
|
|
|
|
|
|
|
# outputs (f1, f2 ... for each individual) |
1033
|
121
|
50
|
|
|
|
8383
|
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? '; |
1034
|
121
|
|
|
|
|
547
|
$to_print = f_print_columns($Pt,'%25.15f'); |
1035
|
121
|
|
|
|
|
2511
|
print $FILEO (join "\n", @$to_print); |
1036
|
121
|
|
|
|
|
3629
|
close $FILEO; |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
#print " example input values: " ; |
1040
|
|
|
|
|
|
|
#say join ' ', @{$VPtp1->[0]}; |
1041
|
|
|
|
|
|
|
|
1042
|
121
|
50
|
|
|
|
587
|
if (defined $par_plot){ |
1043
|
0
|
|
|
|
|
0
|
f_plot($par_plot,$gen,$Ptp1,$rank); |
1044
|
0
|
|
|
|
|
0
|
say ''; |
1045
|
|
|
|
|
|
|
|
1046
|
0
|
|
|
|
|
0
|
my $max = -$inf; |
1047
|
0
|
|
|
|
|
0
|
my $min = $inf; |
1048
|
|
|
|
|
|
|
|
1049
|
0
|
|
|
|
|
0
|
for (0..$nPop-1){ |
1050
|
0
|
|
|
|
|
0
|
$max = max(@{$Pt->[$_]},@{$Qt->[$_]},$max); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1051
|
0
|
|
|
|
|
0
|
$min = min(@{$Pt->[$_]},@{$Qt->[$_]},$min); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1052
|
|
|
|
|
|
|
} |
1053
|
0
|
|
|
|
|
0
|
say 'max output = '.$max; |
1054
|
0
|
|
|
|
|
0
|
say 'min output = '.$min; |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
|
1057
|
0
|
|
|
|
|
0
|
my $maxV = -$inf; |
1058
|
0
|
|
|
|
|
0
|
my $minV= $inf; |
1059
|
|
|
|
|
|
|
|
1060
|
0
|
|
|
|
|
0
|
my $minD = min(@$Dist); |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
|
1063
|
0
|
|
|
|
|
0
|
for (0..$nPop-1){ |
1064
|
|
|
|
|
|
|
|
1065
|
0
|
|
|
|
|
0
|
$maxV = max(@{$VPt->[$_]},@{$VQt->[$_]},$maxV); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1066
|
0
|
|
|
|
|
0
|
$minV = min(@{$VPt->[$_]},@{$VQt->[$_]},$minV); |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
} |
1069
|
0
|
|
|
|
|
0
|
say 'max input = '.$maxV; |
1070
|
0
|
|
|
|
|
0
|
say 'min input = '.$minV; |
1071
|
|
|
|
|
|
|
|
1072
|
0
|
|
|
|
|
0
|
say 'min Dist = '.$minD; |
1073
|
|
|
|
|
|
|
} |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
|
1076
|
121
|
|
|
|
|
660
|
my ($VQtp1) = f_GA($VPtp1,$rank,$Dist,2.0,$bounds,$distrib,$scaleDistrib,$percentMut); |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
# correction of input values produced by GA to respect bounds |
1079
|
121
|
|
|
|
|
347
|
for my $p(0..$nPop-1){ |
1080
|
6050
|
|
|
|
|
6877
|
for my $d(0..$n-1){ |
1081
|
18150
|
50
|
|
|
|
26650
|
if($VQtp1->[$p][$d] < $bounds->[$d][0]){$VQtp1->[$p][$d] = $bounds->[$d][0]}; |
|
0
|
|
|
|
|
0
|
|
1082
|
18150
|
50
|
|
|
|
27256
|
if($VQtp1->[$p][$d] > $bounds->[$d][1]){$VQtp1->[$p][$d] = $bounds->[$d][1]}; |
|
0
|
|
|
|
|
0
|
|
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
# new output |
1087
|
121
|
|
|
|
|
297
|
my $Qtp1; |
1088
|
121
|
|
|
|
|
378
|
for (0..$nPop-1){ |
1089
|
6050
|
|
|
|
|
88578
|
$Qtp1->[$_]=&{$fun}($VQtp1->[$_]); |
|
6050
|
|
|
|
|
10134
|
|
1090
|
|
|
|
|
|
|
} |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
# new became old |
1093
|
121
|
|
|
|
|
7007
|
$VPt = [@$VPtp1]; |
1094
|
121
|
|
|
|
|
5309
|
$VQt = [@$VQtp1]; |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
# output final |
1098
|
121
|
100
|
|
|
|
6177
|
if($gen == $nGen){ |
1099
|
1
|
50
|
|
|
|
10
|
if ($verboseFinal == 1){ |
1100
|
0
|
|
|
|
|
0
|
say '------------------------- I N P U T -------------------------:'; |
1101
|
0
|
|
|
|
|
0
|
map {say join ' ',@{$_}} @$VPt; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1102
|
0
|
|
|
|
|
0
|
say '------------------------- O U T P U T -------------------------'; |
1103
|
0
|
|
|
|
|
0
|
map {say join ' ',@{$_}} @$Pt; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
1104
|
|
|
|
|
|
|
} |
1105
|
|
|
|
|
|
|
|
1106
|
1
|
|
|
|
|
99
|
return [$VPt,$Pt]; |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
} |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
sub f_print_columns { |
1117
|
|
|
|
|
|
|
# to print in columns format the content of $P, $Ptp1 ... |
1118
|
242
|
|
|
242
|
0
|
540
|
my $P = shift; |
1119
|
242
|
|
|
|
|
974
|
my $formato = shift; # e.g. '%25.15f' |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
# how many input parameters (genes) |
1122
|
242
|
|
|
|
|
398
|
my $n = scalar @{$P->[0]}; |
|
242
|
|
|
|
|
709
|
|
1123
|
|
|
|
|
|
|
# population number |
1124
|
242
|
|
|
|
|
452
|
my $nPop = scalar @$P; |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
# print, each line contains the genes of an individual |
1127
|
242
|
|
|
|
|
465
|
my @to_print; |
1128
|
242
|
|
|
|
|
1210
|
for my $kl(0..($nPop-1)){ |
1129
|
12100
|
|
|
|
|
12434
|
my $line; |
1130
|
12100
|
|
|
|
|
15296
|
for my $kx(0..($n-1)){ |
1131
|
30250
|
|
|
|
|
94400
|
$line.= sprintf($formato,$P->[$kl][$kx]) . ' '; |
1132
|
|
|
|
|
|
|
} |
1133
|
12100
|
|
|
|
|
20763
|
push @to_print, $line; |
1134
|
|
|
|
|
|
|
} |
1135
|
|
|
|
|
|
|
|
1136
|
242
|
|
|
|
|
999
|
return \@to_print; |
1137
|
|
|
|
|
|
|
} |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
######################################################################################################## |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
sub f_plot { |
1142
|
0
|
|
|
0
|
0
|
|
my $par_ref = shift; |
1143
|
|
|
|
|
|
|
|
1144
|
0
|
|
|
|
|
|
my $gen = shift; |
1145
|
|
|
|
|
|
|
|
1146
|
0
|
|
|
|
|
|
my $P = shift; |
1147
|
0
|
|
|
|
|
|
my $rank = shift; |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
|
1152
|
0
|
|
|
|
|
|
my %par = %{$par_ref}; |
|
0
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
# nfun: what objective to plot from all (x=f1 y=f4 -> [0,3]) |
1155
|
0
|
|
|
|
|
|
my $nfun = $par{'nfun'}; |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
|
1158
|
0
|
|
|
|
|
|
my $title = 'GENERATION '.$gen; |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# inizialization of all lines of output |
1161
|
0
|
|
|
|
|
|
my @output = map{ ' ' x $par{'dx'} } 1..$par{'dy'}; |
|
0
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
|
1163
|
0
|
|
|
|
|
|
my @nameFront =(0..9,"a".."z","A".."Z"); |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
# print points of the front |
1166
|
0
|
|
|
|
|
|
my $xASCIImin = 0; |
1167
|
0
|
|
|
|
|
|
my $xASCIImax = $par{'dx'}-1; |
1168
|
0
|
|
|
|
|
|
my $yASCIImin = $par{'dy'}-1; |
1169
|
0
|
|
|
|
|
|
my $yASCIImax = 0; |
1170
|
0
|
|
|
|
|
|
my $n_outliers = 0; |
1171
|
|
|
|
|
|
|
|
1172
|
0
|
|
|
|
|
|
for my $kp(1..scalar(@{$P})-1){ |
|
0
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
# conversion x,y -> xASCII,yASCII |
1174
|
0
|
|
|
|
|
|
my $x = $P->[$kp][$nfun->[0]]; |
1175
|
0
|
|
|
|
|
|
my $y = $P->[$kp][$nfun->[1]]; |
1176
|
0
|
|
|
|
|
|
my $xmin = $par{'xlim'}->[0]; |
1177
|
0
|
|
|
|
|
|
my $xmax = $par{'xlim'}->[1]; |
1178
|
0
|
|
|
|
|
|
my $ymin = $par{'ylim'}->[0]; |
1179
|
0
|
|
|
|
|
|
my $ymax = $par{'ylim'}->[1]; |
1180
|
|
|
|
|
|
|
|
1181
|
0
|
|
|
|
|
|
my $xASCII; |
1182
|
|
|
|
|
|
|
my $yASCII; |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
|
1185
|
0
|
0
|
0
|
|
|
|
if ($x < $xmax && $x > $xmin && $y < $ymax && $y > $ymin && $rank->[$kp] < $#nameFront){ |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1186
|
0
|
|
|
|
|
|
$xASCII = f_interp($xmin,$xmax,$xASCIImin,$xASCIImax,$x); |
1187
|
0
|
|
|
|
|
|
$yASCII = f_interp($ymin,$ymax,$yASCIImin,$yASCIImax,$y); |
1188
|
|
|
|
|
|
|
|
1189
|
0
|
|
|
|
|
|
substr($output[$yASCII],$xASCII,1,$nameFront[$rank->[$kp]]); |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
} |
1192
|
0
|
|
|
|
|
|
else {$n_outliers++}; |
1193
|
|
|
|
|
|
|
} |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
# add axis |
1196
|
0
|
|
|
|
|
|
push @output, '_' x $par{'dx'}; |
1197
|
0
|
|
|
|
|
|
@output = map{'|'.$_} @output; |
|
0
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
# add axis labels |
1199
|
0
|
|
|
|
|
|
push @output, sprintf("%$par{'dx'}s",$par{'xlabel'}); |
1200
|
0
|
|
|
|
|
|
my @ylabelv = split '',$par{'ylabel'}; |
1201
|
0
|
0
|
|
|
|
|
@output = map{ defined $ylabelv[$_] ? $ylabelv[$_].$output[$_] : ' '.$output[$_]} 0..$#output; |
|
0
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
# add statistics |
1203
|
0
|
|
|
|
|
|
unshift @output, sprintf("%".int(($par{'dx'}+length($title))/2)."s",$title); |
1204
|
0
|
|
|
|
|
|
push @output, "xlim: ".(join ' ',@{$par{'xlim'}}); |
|
0
|
|
|
|
|
|
|
1205
|
0
|
|
|
|
|
|
push @output, "ylim: ".(join ' ',@{$par{'ylim'}}); |
|
0
|
|
|
|
|
|
|
1206
|
0
|
|
|
|
|
|
push @output, "#outliers: ".$n_outliers; |
1207
|
|
|
|
|
|
|
|
1208
|
0
|
|
|
|
|
|
print join "\n", @output; |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
} |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
sub f_interp{ |
1214
|
0
|
|
|
0
|
0
|
|
my ($xmin,$xmax,$xASCIImin,$xASCIImax,$x) = @_; |
1215
|
0
|
|
|
|
|
|
my $xASCII = ($xASCIImax-$xASCIImin)/($xmax-$xmin)*($x-$xmin)+$xASCIImin; |
1216
|
0
|
|
|
|
|
|
$xASCII = sprintf("%.0f",$xASCII); |
1217
|
0
|
|
|
|
|
|
return $xASCII |
1218
|
|
|
|
|
|
|
} |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
1; |