line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sim::OPT::Descend; |
2
|
|
|
|
|
|
|
# Copyright (C) 2008-2014 by Gian Luca Brunetti and Politecnico di Milano. |
3
|
|
|
|
|
|
|
# This is the module Sim::OPT::Descend of Sim::OPT, a program for detailed metadesign managing parametric explorations through the ESP-r building performance simulation platform and performing optimization by block coordinate descent. |
4
|
|
|
|
|
|
|
# This is free software. You can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2. |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
8
|
use v5.14; |
|
1
|
|
|
|
|
2
|
|
7
|
|
|
|
|
|
|
# use v5.20; |
8
|
1
|
|
|
1
|
|
6
|
use Exporter; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
53
|
|
9
|
1
|
|
|
1
|
|
5
|
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
55
|
|
10
|
1
|
|
|
1
|
|
3
|
use Math::Trig; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
131
|
|
11
|
1
|
|
|
1
|
|
4
|
use Math::Round; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
66
|
|
12
|
1
|
|
|
1
|
|
5
|
use List::Util qw[ min max reduce shuffle]; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
84
|
|
13
|
1
|
|
|
1
|
|
6
|
use List::MoreUtils qw(uniq); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
8
|
|
14
|
1
|
|
|
1
|
|
408
|
use List::AllUtils qw(sum); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
61
|
|
15
|
1
|
|
|
1
|
|
6
|
use Statistics::Basic qw(:all); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
7
|
|
16
|
1
|
|
|
1
|
|
651
|
use Set::Intersection; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
108
|
|
17
|
1
|
|
|
1
|
|
7
|
use List::Compare; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
30
|
|
18
|
1
|
|
|
1
|
|
4
|
use IO::Tee; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
53
|
|
19
|
1
|
|
|
1
|
|
7
|
use Data::Dumper; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
47
|
|
20
|
|
|
|
|
|
|
#$Data::Dumper::Indent = 0; |
21
|
|
|
|
|
|
|
#$Data::Dumper::Useqq = 1; |
22
|
|
|
|
|
|
|
#$Data::Dumper::Terse = 1; |
23
|
1
|
|
|
1
|
|
4
|
use Data::Dump qw(dump); |
|
1
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
51
|
|
24
|
1
|
|
|
1
|
|
5
|
use feature 'say'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
76
|
|
25
|
1
|
|
|
1
|
|
4
|
use Sim::OPT; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
30
|
|
26
|
1
|
|
|
1
|
|
4
|
use Sim::OPT::Morph; |
|
1
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
15
|
|
27
|
1
|
|
|
1
|
|
2
|
use Sim::OPT::Sim; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
17
|
|
28
|
1
|
|
|
1
|
|
3
|
use Sim::OPT::Retrieve; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
13
|
|
29
|
1
|
|
|
1
|
|
3
|
use Sim::OPT::Report; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
21
|
|
30
|
1
|
|
|
1
|
|
630
|
use Sim::OPT::Takechance; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
85
|
|
31
|
|
|
|
|
|
|
|
32
|
1
|
|
|
1
|
|
10
|
no strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
33
|
1
|
|
|
1
|
|
4
|
no warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
3851
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
@ISA = qw(Exporter); # our @adamkISA = qw(Exporter); |
36
|
|
|
|
|
|
|
#%EXPORT_TAGS = ( DEFAULT => [qw( &opt &prepare )]); # our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); |
37
|
|
|
|
|
|
|
#@EXPORT_OK = qw(); # our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
@EXPORT = qw( descend ); # our @EXPORT = qw( ); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$VERSION = '0.40.0'; # our $VERSION = ''; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
######################################################################################### |
45
|
|
|
|
|
|
|
# HERE FOLLOWS THE CONTENT OF "Descend.pm" - Sim::OPT::Descend |
46
|
|
|
|
|
|
|
############################################################################## |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub descend |
49
|
|
|
|
|
|
|
{ |
50
|
0
|
|
|
0
|
0
|
|
my $swap = shift; #say TOSHELL "swapINDESCEND: " . dump($swap); |
51
|
0
|
|
|
|
|
|
my %dat = %$swap; |
52
|
0
|
|
|
|
|
|
my @instances = @{ $dat{instances} }; #say "scalar(\@instances): " . scalar(@instances); |
|
0
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
|
my $countcase = $dat{countcase}; #say "dump(\$countcase): " . dump($countcase); # IT WILL BE SHADOWED. CUT ZZZ |
54
|
0
|
|
|
|
|
|
my $countblock = $dat{countblock}; #say "dump(\$countblock): " . dump($countblock); # IT WILL BE SHADOWED. CUT ZZZ |
55
|
0
|
|
|
|
|
|
my %dirfiles = %{ $dat{dirfiles} }; #say "dump(\%dirfiles): " . dump(%dirfiles); |
|
0
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
my $repfile = $dat{repfile}; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
$configfile = $main::configfile; #say "dump(\$configfile): " . dump($configfile); |
59
|
0
|
|
|
|
|
|
@sweeps = @main::sweeps; #say "dump(\@sweeps): " . dump(@sweeps); |
60
|
0
|
|
|
|
|
|
@varinumbers = @main::varinumbers; #say "dump(\@varinumbers): " . dump(@varinumbers); |
61
|
0
|
|
|
|
|
|
@mediumiters = @main::mediumiters; |
62
|
0
|
|
|
|
|
|
@rootnames = @main::rootnames; #say "dump(\@rootnames): " . dump(@rootnames); |
63
|
0
|
|
|
|
|
|
%vals = %main::vals; #say "dump(\%vals): " . dump(%vals); |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
$mypath = $main::mypath; #say TOSHELL "dumpINDESCEND(\$mypath): " . dump($mypath); |
66
|
0
|
|
|
|
|
|
$exeonfiles = $main::exeonfiles; #say TOSHELL "dumpINDESCEND(\$exeonfiles): " . dump($exeonfiles); |
67
|
0
|
|
|
|
|
|
$generatechance = $main::generatechance; |
68
|
0
|
|
|
|
|
|
$file = $main::file; |
69
|
0
|
|
|
|
|
|
$preventsim = $main::preventsim; |
70
|
0
|
|
|
|
|
|
$fileconfig = $main::fileconfig; #say TOSHELL "dumpINDESCEND(\$fileconfig): " . dump($fileconfig); # NOW GLOBAL. TO MAKE IT PRIVATE, FIX PASSING OF PARAMETERS IN CONTRAINTS PROPAGATION SECONDARY SUBROUTINES |
71
|
0
|
|
|
|
|
|
$outfile = $main::outfile; |
72
|
0
|
|
|
|
|
|
$toshell = $main::toshell; |
73
|
0
|
|
|
|
|
|
$report = $main::report; |
74
|
0
|
|
|
|
|
|
$simnetwork = $main::simnetwork; |
75
|
|
|
|
|
|
|
|
76
|
0
|
0
|
|
|
|
|
open ( OUTFILE, ">>$outfile" ) or die "Can't open $outfile: $!"; |
77
|
0
|
0
|
|
|
|
|
open ( TOSHELL, ">>$toshell" ) or die "Can't open $toshell: $!"; |
78
|
0
|
|
|
|
|
|
$tee = new IO::Tee(\*STDOUT, ">>$toshell"); # GLOBAL ZZZ |
79
|
0
|
|
|
|
|
|
say "\nNow in Sim::OPT::Descend.\n"; |
80
|
0
|
|
|
|
|
|
say TOSHELL "\n#Now in Sim::OPT::Descend.\n"; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
#say TOSHELL "dump(\$repfile): " . dump($repfile); |
83
|
0
|
|
|
|
|
|
%dowhat = %main::dowhat; |
84
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
@themereports = @main::themereports; #say "dumpINDESCEND(\@themereports): " . dump(@themereports); |
86
|
0
|
|
|
|
|
|
@simtitles = @main::simtitles; #say "dumpINDESCEND(\@simtitles): " . dump(@simtitles); |
87
|
0
|
|
|
|
|
|
@reporttitles = @main::reporttitles; |
88
|
0
|
|
|
|
|
|
@simdata = @main::simdata; |
89
|
0
|
|
|
|
|
|
@retrievedata = @main::retrievedata; |
90
|
0
|
|
|
|
|
|
@keepcolumns = @main::keepcolumns; |
91
|
0
|
|
|
|
|
|
@weights = @main::weights; |
92
|
0
|
|
|
|
|
|
@weightsaim = @main::weightsaim; |
93
|
0
|
|
|
|
|
|
@varthemes_report = @main::varthemes_report; |
94
|
0
|
|
|
|
|
|
@varthemes_variations = @vmain::arthemes_variations; |
95
|
0
|
|
|
|
|
|
@varthemes_steps = @main::varthemes_steps; |
96
|
0
|
|
|
|
|
|
@rankdata = @main::rankdata; # CUT ZZZ |
97
|
0
|
|
|
|
|
|
@rankcolumn = @main::rankcolumn; |
98
|
0
|
|
|
|
|
|
@reporttempsdata = @main::reporttempsdata; |
99
|
0
|
|
|
|
|
|
@reportcomfortdata = @main::reportcomfortdata; |
100
|
0
|
|
|
|
|
|
@reportradiationenteringdata = @main::reportradiationenteringdata; |
101
|
0
|
|
|
|
|
|
@report_loadsortemps = @main::report_loadsortemps; |
102
|
0
|
|
|
|
|
|
@files_to_filter = @main::files_to_filter; |
103
|
0
|
|
|
|
|
|
@filter_reports = @main::filter_reports; |
104
|
0
|
|
|
|
|
|
@base_columns = @main::base_columns; |
105
|
0
|
|
|
|
|
|
@maketabledata = @main::maketabledata; |
106
|
0
|
|
|
|
|
|
@filter_columns = @main::filter_columns; |
107
|
|
|
|
|
|
|
|
108
|
0
|
|
|
|
|
|
my @simcases = @{ $dirfiles{simcases} }; #say "dump(\@simcases): " . dump(@simcases); |
|
0
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
my @simstruct = @{ $dirfiles{simstruct} }; #say "dump(\@simstruct): " . dump(@simstruct); |
|
0
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
my @morphcases = @{ $dirfiles{morphcases} }; |
|
0
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
|
my @morphstruct = @{ $dirfiles{morphstruct} }; |
|
0
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
my @retcases = @{ $dirfiles{retcases} }; #say TOSHELL "dumpINDESCEND2(\@retcases): " . dump(@retcases); say "dumpINDESCEND(\@retcases): " . dump(@retcases); |
|
0
|
|
|
|
|
|
|
113
|
0
|
|
|
|
|
|
my @retstruct = @{ $dirfiles{retstruct} }; #say "dump(\@retstruct): " . dump(@retstruct); |
|
0
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my @repcases = @{ $dirfiles{repcases} }; |
|
0
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
my @repstruct = @{ $dirfiles{repstruct} }; |
|
0
|
|
|
|
|
|
|
116
|
0
|
|
|
|
|
|
my @mergecases = @{ $dirfiles{mergecases} }; |
|
0
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
my @mergestruct = @{ $dirfiles{mergestruct} }; |
|
0
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
|
my @descendcases = @{ $dirfiles{descendcases} }; |
|
0
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
my @descendstruct = @{ $dirfiles{descendstruct} }; |
|
0
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
my $morphlist = $dirfiles{morphlist}; #say "dump(\$dat{morphlist}): " . dump($dat{morphlist}); |
122
|
0
|
|
|
|
|
|
my $morphblock = $dirfiles{morphblock}; |
123
|
0
|
|
|
|
|
|
my $simlist = $dirfiles{simlist}; #say "dump(\$simlist): " . dump($simlist); |
124
|
0
|
|
|
|
|
|
my $simblock = $dirfiles{simblock}; |
125
|
0
|
|
|
|
|
|
my $retlist = $dirfiles{retlist}; |
126
|
0
|
|
|
|
|
|
my $retblock = $dirfiles{retblock}; |
127
|
0
|
|
|
|
|
|
my $replist = $dirfiles{replist}; |
128
|
0
|
|
|
|
|
|
my $repblock = $dirfiles{repblock}; |
129
|
0
|
|
|
|
|
|
my $descendlist = $dirfiles{descendlist}; |
130
|
0
|
|
|
|
|
|
my $descendblock = $dirfiles{descendblock}; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
#my $getpars = shift; |
133
|
|
|
|
|
|
|
#eval( $getpars ); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
#if ( fileno (MORPHLIST) |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
#my $getpars = shift; |
138
|
|
|
|
|
|
|
#eval( $getpars ); |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
my $instance = $instances[0]; # THIS WOULD HAVE TO BE A LOOP HERE TO MIX ALL THE MERGECASES!!! ### ZZZ |
141
|
|
|
|
|
|
|
|
142
|
0
|
|
|
|
|
|
my %d = %{$instance}; |
|
0
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
|
my $countcase = $d{countcase}; #say TOSHELL "dump(\$countcase): " . dump($countcase); |
144
|
0
|
|
|
|
|
|
my $countblock = $d{countblock}; #say TOSHELL "dump(\$countblock): " . dump($countblock); |
145
|
0
|
|
|
|
|
|
my @miditers = @{ $d{miditers} }; #say TOSHELL "BEGINDESCENDdump(\@miditers): " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
my @winneritems = @{ $d{winneritems} }; #say TOSHELL "dumpIN( \@winneritems) " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
my $countvar = $d{countvar}; #say TOSHELL "dump(\$countvar): " . dump($countvar); |
148
|
0
|
|
|
|
|
|
my $countstep = $d{countstep}; #say TOSHELL "dump(\$countstep): " . dump($countstep); |
149
|
0
|
|
|
|
|
|
my $to = $d{to}; #say TOSHELL "dump(\$to): " . dump($to); |
150
|
0
|
|
|
|
|
|
my $origin = $d{origin}; #say TOSHELL "dump(\$origin): " . dump($origin); |
151
|
0
|
|
|
|
|
|
my @uplift = @{ $d{uplift} }; #say TOSHELL "dump(\@uplift): " . dump(@uplift); |
|
0
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
#eval($getparshere); |
153
|
|
|
|
|
|
|
|
154
|
0
|
|
|
|
|
|
my $rootname = Sim::OPT::getrootname(\@rootnames, $countcase); #say TOSHELL "dump(\$rootname): " . dump($rootname); |
155
|
0
|
|
|
|
|
|
my @blockelts = Sim::OPT::getblockelts(\@sweeps, $countcase, $countblock); #say TOSHELL "dumpIN( \@blockelts) " . dump(@blockelts); |
156
|
0
|
|
|
|
|
|
my @blocks = Sim::OPT::getblocks(\@sweeps, $countcase); #say TOSHELL "dumpIN( \@blocks) " . dump(@blocks); |
157
|
0
|
|
|
|
|
|
my $toitem = Sim::OPT::getitem(\@winneritems, $countcase, $countblock); #say TOSHELL "dump(\$toitem): " . dump($toitem); |
158
|
0
|
|
|
|
|
|
my $from = Sim::OPT::getline($toitem); #say TOSHELL "dumpIN(\$from): " . dump($from); |
159
|
0
|
|
|
|
|
|
my %varnums = Sim::OPT::getcase(\@varinumbers, $countcase); #say TOSHELL "dumpIN---(\%varnums): " . dump(%varnums); |
160
|
0
|
|
|
|
|
|
my %mids = Sim::OPT::getcase(\@miditers, $countcase); #say TOSHELL "dumpIN---(\%mids): " . dump(%mids); |
161
|
|
|
|
|
|
|
#eval($getfly); |
162
|
|
|
|
|
|
|
|
163
|
0
|
|
|
|
|
|
my $stepsvar = Sim::OPT::getstepsvar($countvar, $countcase, \@varinumbers); #say TOSHELL "dump(\$stepsvar): " . dump($stepsvar); |
164
|
0
|
|
|
|
|
|
my $varnumber = $countvar; #say TOSHELL "dump---(\$varnumber): " . dump($varnumber) . "\n\n"; # LEGACY VARIABLE |
165
|
0
|
|
|
|
|
|
my $contblocksplus = ($countblock + 1); |
166
|
0
|
|
|
|
|
|
my $countcaseplus = ($countcase + 1); |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
#say "0\$countcase : " . dump($countcase); |
169
|
|
|
|
|
|
|
#say "0\@rootnames : " . dump(@rootnames); |
170
|
|
|
|
|
|
|
#say "0\$countblock : " . dump($countblock); |
171
|
|
|
|
|
|
|
#say "0\@sweeps : " . dump(@sweeps); |
172
|
|
|
|
|
|
|
#say "0\@varinumbers : " . dump(@varinumbers); |
173
|
|
|
|
|
|
|
#say "0\@miditers : " . dump(@miditers); |
174
|
|
|
|
|
|
|
#say "0\@winneritems : " . dump(@winneritems); |
175
|
|
|
|
|
|
|
#say "0\@morphcases : " . dump(@morphcases); |
176
|
|
|
|
|
|
|
#say "0\@morphstruct : " . dump(@morphstruct); |
177
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
say "Descending into case $countcaseplus, block $contblocksplus."; |
179
|
0
|
|
|
|
|
|
say TOSHELL "#Descending into case $countcaseplus, block $contblocksplus."; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
my @columns_to_report = @{ $reporttempsdata[1] }; |
|
0
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
my $number_of_columns_to_report = scalar(@columns_to_report); |
183
|
0
|
|
|
|
|
|
my $counterlines; |
184
|
0
|
|
|
|
|
|
my $number_of_dates_to_mix = scalar(@simtitles); |
185
|
0
|
|
|
|
|
|
my @dates = @simtitles; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
my $cleanfile = "$repfile-clean.csv"; #say TOSHELL "dump(\$cleanfile): " . dump($cleanfile); |
188
|
0
|
|
|
|
|
|
my $throw = $cleanfile; $throw =~ s/\.csv//; |
|
0
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
my $selectmixed = "$throw-select.csv"; #say TOSHELL "dump(\$selectmixed): " . dump($selectmixed); |
190
|
|
|
|
|
|
|
sub cleanselect |
191
|
|
|
|
|
|
|
{ # CLEANS THE MIXED FILE AND SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE |
192
|
0
|
|
|
0
|
0
|
|
say "Cleaning results for case $countcaseplus, block $contblocksplus."; |
193
|
0
|
|
|
|
|
|
say TOSHELL "#Cleaning results for case $countcaseplus, block $contblocksplus."; |
194
|
0
|
0
|
|
|
|
|
open ( MIXFILE, $repfile ) or die; #say TOSHELL "dump(\$repfile): " . dump($repfile); |
195
|
0
|
|
|
|
|
|
my @lines = ; #say TOSHELL "dump(MIXFILE \@lines): " . dump(@lines); |
196
|
0
|
|
|
|
|
|
close MIXFILE; |
197
|
0
|
|
|
|
|
|
open ( CLEANMIXED, ">$cleanfile"); # or die; |
198
|
0
|
|
|
|
|
|
foreach my $line (@lines) |
199
|
|
|
|
|
|
|
{ |
200
|
0
|
|
|
|
|
|
$line =~ s/\n/°/g; |
201
|
0
|
|
|
|
|
|
$line =~ s/\s+/,/g; |
202
|
0
|
|
|
|
|
|
$line =~ s/°/\n/g; |
203
|
0
|
|
|
|
|
|
print CLEANMIXED "$line"; |
204
|
|
|
|
|
|
|
} |
205
|
0
|
|
|
|
|
|
close CLEANMIXED; |
206
|
|
|
|
|
|
|
# END. CLEANS THE MIXED FILE |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE |
209
|
0
|
|
|
|
|
|
open (CLEANMIXED, $cleanfile); # or die; |
210
|
0
|
|
|
|
|
|
my @lines = ; #say TOSHELL "dump(CLEANMIXED \@lines): " . dump(@lines); |
211
|
0
|
|
|
|
|
|
close CLEANMIXED; |
212
|
0
|
0
|
|
|
|
|
open (SELECTEDMIXED, ">$selectmixed") or die; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
foreach my $line (@lines) |
216
|
|
|
|
|
|
|
{ |
217
|
0
|
|
|
|
|
|
my @elts = split(/\s+|,/, $line); ### DDD |
218
|
0
|
|
|
|
|
|
$elts[0] =~ /^(.*)_-(.*)/; |
219
|
0
|
|
|
|
|
|
my $touse = $1; #say "dump(CLEANMIXED \$touse): " . dump($touse); |
220
|
0
|
|
|
|
|
|
$touse =~ s/$mypath\///; |
221
|
0
|
|
|
|
|
|
print SELECTEDMIXED "$touse,"; |
222
|
0
|
|
|
|
|
|
my $countout = 0; |
223
|
0
|
|
|
|
|
|
foreach my $elmref (@keepcolumns) |
224
|
|
|
|
|
|
|
{ |
225
|
0
|
|
|
|
|
|
my @cols = @{$elmref}; |
|
0
|
|
|
|
|
|
|
226
|
0
|
|
|
|
|
|
my $countin = 0; |
227
|
0
|
|
|
|
|
|
foreach my $elm (@cols) |
228
|
|
|
|
|
|
|
{ |
229
|
0
|
0
|
|
|
|
|
if ( Sim::OPT::odd($countin) ) |
230
|
|
|
|
|
|
|
{ |
231
|
0
|
|
|
|
|
|
print SELECTEDMIXED "$elts[$elm]"; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
else |
234
|
|
|
|
|
|
|
{ |
235
|
0
|
|
|
|
|
|
print SELECTEDMIXED "$elm"; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
0
|
0
|
0
|
|
|
|
if ( ( $countout < $#keepcolumns ) or ( $countin < $#cols) ) |
239
|
|
|
|
|
|
|
{ |
240
|
0
|
|
|
|
|
|
print SELECTEDMIXED ","; |
241
|
|
|
|
|
|
|
} |
242
|
0
|
|
|
|
|
|
else {print SELECTEDMIXED "\n";} |
243
|
0
|
|
|
|
|
|
$countin++; |
244
|
|
|
|
|
|
|
} |
245
|
0
|
|
|
|
|
|
$countout++; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
0
|
|
|
|
|
|
close SELECTEDMIXED; |
249
|
|
|
|
|
|
|
} # END. CLEANS THE MIXED FILE AND SELECTS SOME COLUMNS AND COPIES THEM IN ANOTHER FILE |
250
|
0
|
|
|
|
|
|
&cleanselect(); |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
my $throw = $selectmixed; $throw =~ s/\.csv//; |
|
0
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
my $weight = "$throw-weight.csv"; #say TOSHELL "dump(\$weight): " . dump($weight); # THIS WILL HOST PARTIALLY SCALED VALUES, MADE POSITIVE AND WITH A CEILING OF 1 |
254
|
|
|
|
|
|
|
sub weight |
255
|
|
|
|
|
|
|
{ |
256
|
0
|
|
|
0
|
0
|
|
say "Scaling results for case $countcaseplus, block $contblocksplus."; |
257
|
0
|
|
|
|
|
|
say TOSHELL "#Scaling results for case $countcaseplus, block $contblocksplus."; |
258
|
0
|
0
|
|
|
|
|
open (SELECTEDMIXED, $selectmixed) or die; #say TOSHELL "dump(\$selectmixed): " . dump($selectmixed); |
259
|
0
|
|
|
|
|
|
my @lines = ; #say TOSHELL "dump(SELECTEDMIXED \@lines): " . dump(@lines); |
260
|
0
|
|
|
|
|
|
close SELECTEDMIXED; |
261
|
0
|
|
|
|
|
|
my $counterline = 0; |
262
|
0
|
|
|
|
|
|
open (WEIGHT, ">$weight"); # or die; |
263
|
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
my @containerone; |
265
|
|
|
|
|
|
|
my @containernames; |
266
|
0
|
|
|
|
|
|
foreach my $line (@lines) |
267
|
|
|
|
|
|
|
{ |
268
|
0
|
|
|
|
|
|
$line =~ s/^[\n]//; |
269
|
0
|
|
|
|
|
|
my @elts = split(/\s+|,/, $line); |
270
|
0
|
|
|
|
|
|
my $touse = shift(@elts); |
271
|
0
|
|
|
|
|
|
my $countcol = 0; |
272
|
0
|
|
|
|
|
|
my $countel = 0; |
273
|
0
|
|
|
|
|
|
foreach my $elt (@elts) |
274
|
|
|
|
|
|
|
{ |
275
|
0
|
0
|
|
|
|
|
if ( Sim::OPT::odd($countel) ) |
276
|
|
|
|
|
|
|
{ |
277
|
0
|
|
|
|
|
|
push ( @{$containerone[$countcol]}, $elt); #print $_outfile_ "ELT: $elt\n"; |
|
0
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
$countcol++; |
279
|
|
|
|
|
|
|
} |
280
|
0
|
|
|
|
|
|
push (@containernames, $touse); |
281
|
0
|
|
|
|
|
|
$countel++; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
#say TOSHELL "dump(SELECTEDMIXED \@containernames): " . dump(@containernames); |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
my @containertwo; |
287
|
|
|
|
|
|
|
my @containerthree; |
288
|
0
|
|
|
|
|
|
$countcolm = 0; |
289
|
0
|
|
|
|
|
|
my @optimals; |
290
|
0
|
|
|
|
|
|
foreach my $colref (@containerone) |
291
|
|
|
|
|
|
|
{ |
292
|
0
|
|
|
|
|
|
my @column = @{$colref}; # DEREFERENCE |
|
0
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
|
294
|
0
|
0
|
|
|
|
|
if ( $weights[$countcolm] < 0 ) # TURNS EVERYTHING POSITIVE |
295
|
|
|
|
|
|
|
{ |
296
|
0
|
|
|
|
|
|
foreach $el (@column) |
297
|
|
|
|
|
|
|
{ |
298
|
0
|
|
|
|
|
|
$el = ($el * -1); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
0
|
0
|
|
|
|
|
if ( max(@column) != 0) # FILLS THE UNTRACTABLE VALUES |
303
|
|
|
|
|
|
|
{ |
304
|
0
|
|
|
|
|
|
push (@maxes, max(@column)); |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
else |
307
|
|
|
|
|
|
|
{ |
308
|
0
|
|
|
|
|
|
push (@maxes, "NOTHING1"); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
#print $_outfile_ "MAXES: " . Dumper(@maxes) . "\n"; |
312
|
|
|
|
|
|
|
#print $_outfile_ "DUMPCOLUMN: " . Dumper(@column) . "\n"; |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
|
|
|
foreach my $el (@column) |
315
|
|
|
|
|
|
|
{ |
316
|
0
|
|
|
|
|
|
my $eltrans; |
317
|
0
|
0
|
|
|
|
|
if ( $maxes[$countcolm] != 0 ) |
318
|
|
|
|
|
|
|
{ |
319
|
|
|
|
|
|
|
#print $_outfile_ "\$weights[\$countcolm]: $weights[$countcolm]\n"; |
320
|
0
|
|
|
|
|
|
$eltrans = ( $el / $maxes[$countcolm] ) ; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
else |
323
|
|
|
|
|
|
|
{ |
324
|
0
|
|
|
|
|
|
$eltrans = "NOTHING2" ; |
325
|
|
|
|
|
|
|
} |
326
|
0
|
|
|
|
|
|
push ( @{$containertwo[$countcolm]}, $eltrans) ; #print $_outfile_ "ELTRANS: $eltrans\n"; |
|
0
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
} |
328
|
0
|
|
|
|
|
|
$countcolm++; |
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
#print $_outfile_ "CONTAINERTWO " . Dumper(@containertwo) . "\n"; |
331
|
|
|
|
|
|
|
|
332
|
0
|
|
|
|
|
|
my $countline = 0; |
333
|
0
|
|
|
|
|
|
foreach my $line (@lines) |
334
|
|
|
|
|
|
|
{ |
335
|
0
|
|
|
|
|
|
$line =~ s/^[\n]//; |
336
|
0
|
|
|
|
|
|
my @elts = split(/\s+|,/, $line); |
337
|
0
|
|
|
|
|
|
my $countcolm = 0; |
338
|
0
|
|
|
|
|
|
foreach $eltref (@containertwo) |
339
|
|
|
|
|
|
|
{ |
340
|
0
|
|
|
|
|
|
my @col = @{$eltref}; |
|
0
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
|
my $max = max(@col); #print $_outfile_ "MAX: $max\n"; |
342
|
0
|
|
|
|
|
|
my $min = min(@col); #print $_outfile_ "MIN: $min\n"; |
343
|
0
|
|
|
|
|
|
my $floordistance = ($max - $min); |
344
|
0
|
|
|
|
|
|
my $range = ( $min / $max); |
345
|
0
|
|
|
|
|
|
my $el = $col[$countline]; |
346
|
0
|
|
|
|
|
|
my $rescaledel; |
347
|
0
|
0
|
|
|
|
|
if ( $floordistance != 0 ) |
348
|
|
|
|
|
|
|
{ |
349
|
0
|
|
|
|
|
|
$rescaledel = ( ( $el - $min ) / $floordistance ) ; |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
else |
352
|
|
|
|
|
|
|
{ |
353
|
0
|
|
|
|
|
|
$rescaledel = 1; |
354
|
|
|
|
|
|
|
} |
355
|
0
|
0
|
|
|
|
|
if ( $weightsaim[$countcolm] < 0) |
356
|
|
|
|
|
|
|
{ |
357
|
0
|
|
|
|
|
|
$rescaledel = ( 1 - $rescaledel); |
358
|
|
|
|
|
|
|
} |
359
|
0
|
|
|
|
|
|
push (@elts, $rescaledel); |
360
|
0
|
|
|
|
|
|
$countcolm++; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
|
$countline++; |
364
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
|
my $counter = 0; |
366
|
0
|
|
|
|
|
|
foreach my $el (@elts) |
367
|
|
|
|
|
|
|
{ |
368
|
0
|
|
|
|
|
|
print WEIGHT "$el"; |
369
|
0
|
0
|
|
|
|
|
if ($counter < $#elts) |
370
|
|
|
|
|
|
|
{ |
371
|
0
|
|
|
|
|
|
print WEIGHT ","; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
else |
374
|
|
|
|
|
|
|
{ |
375
|
0
|
|
|
|
|
|
print WEIGHT "\n"; |
376
|
|
|
|
|
|
|
} |
377
|
0
|
|
|
|
|
|
$containerthree[$counterline][$counter] = $el; |
378
|
0
|
|
|
|
|
|
$counter++; |
379
|
|
|
|
|
|
|
} |
380
|
0
|
|
|
|
|
|
$counterline++; |
381
|
|
|
|
|
|
|
} |
382
|
0
|
|
|
|
|
|
close WEIGHT; |
383
|
|
|
|
|
|
|
#print $_outfile_ "CONTAINERTHREE: " . Dumper(@containerthree) . "\n"; |
384
|
|
|
|
|
|
|
} |
385
|
0
|
|
|
|
|
|
&weight(); # |
386
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
my $throw = $selectmixed; $throw =~ s/\.csv//; |
|
0
|
|
|
|
|
|
|
388
|
0
|
|
|
|
|
|
my $weighttwo = "$throw-weighttwo.csv"; # THIS WILL HOST PARTIALLY SCALED VALUES, MADE POSITIVE AND WITH A CELING OF 1 |
389
|
|
|
|
|
|
|
sub weighttwo |
390
|
|
|
|
|
|
|
{ |
391
|
0
|
|
|
0
|
0
|
|
say "Weighting results for case $countcaseplus, block $contblocksplus."; |
392
|
0
|
|
|
|
|
|
say TOSHELL "#Weighting results for case $countcaseplus, block $contblocksplus."; |
393
|
0
|
|
|
|
|
|
open (WEIGHT, $weight); #say TOSHELL "dump(\$weight): " . dump($weight); |
394
|
0
|
|
|
|
|
|
my @lines = ; |
395
|
0
|
|
|
|
|
|
close WEIGHT; |
396
|
0
|
|
|
|
|
|
open (WEIGHTTWO, ">$weighttwo"); #say TOSHELL "dump(\$weighttwo): " . dump($weighttwo); |
397
|
0
|
|
|
|
|
|
my $counterline; |
398
|
0
|
|
|
|
|
|
foreach my $line (@lines) |
399
|
|
|
|
|
|
|
{ |
400
|
0
|
|
|
|
|
|
$line =~ s/^[\n]//; |
401
|
0
|
|
|
|
|
|
my @elts = split(/\s+|,/, $line); |
402
|
0
|
|
|
|
|
|
my $counterelt = 0; |
403
|
0
|
|
|
|
|
|
my $counterin = 0; |
404
|
0
|
|
|
|
|
|
my $sum = 0; |
405
|
0
|
|
|
|
|
|
my $avg; |
406
|
0
|
|
|
|
|
|
my $numberels = scalar(@keepcolumns); |
407
|
0
|
|
|
|
|
|
foreach my $elt (@elts) |
408
|
|
|
|
|
|
|
{ |
409
|
0
|
|
|
|
|
|
my $newelt; |
410
|
0
|
0
|
|
|
|
|
if ($counterelt > ( $#elts - $numberels )) |
411
|
|
|
|
|
|
|
{ |
412
|
|
|
|
|
|
|
#print $_outfile_ "ELT: $elt\n"; |
413
|
0
|
|
|
|
|
|
$newelt = ( $elt * abs($weights[$counterin]) ); # print $_outfile_ "NEWELT: $newelt\n"; |
414
|
|
|
|
|
|
|
# print $_outfile_ "ABS" . abs($weights[$counterin]) . "\n"; |
415
|
0
|
|
|
|
|
|
$sum = ( $sum + $newelt ) ; # print $_outfile_ "SUM: $sum\n"; |
416
|
0
|
|
|
|
|
|
$counterin++; |
417
|
|
|
|
|
|
|
} |
418
|
0
|
|
|
|
|
|
$counterelt++; |
419
|
|
|
|
|
|
|
} |
420
|
0
|
|
|
|
|
|
$avg = ($sum / scalar(@keepcolumns) ); |
421
|
0
|
|
|
|
|
|
push ( @elts, $avg); |
422
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
|
my $counter = 0; |
424
|
0
|
|
|
|
|
|
foreach my $elt (@elts) |
425
|
|
|
|
|
|
|
{ |
426
|
0
|
|
|
|
|
|
print WEIGHTTWO "$elt"; |
427
|
0
|
0
|
|
|
|
|
if ($counter < $#elts) |
428
|
|
|
|
|
|
|
{ |
429
|
0
|
|
|
|
|
|
print WEIGHTTWO ","; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
else |
432
|
|
|
|
|
|
|
{ |
433
|
0
|
|
|
|
|
|
print WEIGHTTWO "\n"; |
434
|
|
|
|
|
|
|
} |
435
|
0
|
|
|
|
|
|
$counter++; |
436
|
|
|
|
|
|
|
} |
437
|
0
|
|
|
|
|
|
$counterline++; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} |
440
|
0
|
|
|
|
|
|
&weighttwo(); |
441
|
0
|
|
|
|
|
|
$sortmixed = "$repfile-sortmixed.csv"; |
442
|
|
|
|
|
|
|
#if ($repfile) { $sortmixed = "$repfile-sortmixed.csv"; } else { die; } # globsAL! |
443
|
|
|
|
|
|
|
sub sortmixed |
444
|
|
|
|
|
|
|
{ |
445
|
0
|
|
|
0
|
0
|
|
say "Processing results for case $countcaseplus, block $contblocksplus."; |
446
|
0
|
|
|
|
|
|
say TOSHELL "#Processing results for case $countcaseplus, block $contblocksplus."; |
447
|
0
|
0
|
|
|
|
|
open (WEIGHTTWO, $weighttwo)or die; #say TOSHELL "dump(\$weighttwo): " . dump($weighttwo); |
448
|
0
|
0
|
|
|
|
|
open (SORTMIXED_, ">$sortmixed") or die; #say TOSHELL "dump(\$sortmixed): " . dump($sortmixed); |
449
|
0
|
|
|
|
|
|
my @lines = ; |
450
|
0
|
|
|
|
|
|
close WEIGHTTWO; |
451
|
0
|
|
|
|
|
|
my $count = 0; |
452
|
0
|
|
|
|
|
|
foreach (@lines) |
453
|
|
|
|
|
|
|
{ |
454
|
0
|
|
|
|
|
|
$_ = "$containernames[$count]," . "$_"; |
455
|
0
|
|
|
|
|
|
$count++; |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA--dump(\@lines): " . dump(@lines); |
458
|
|
|
|
|
|
|
|
459
|
0
|
|
|
|
|
|
my $line = $lines[0]; |
460
|
0
|
|
|
|
|
|
my @eltstemp = split(/,/, $line); |
461
|
0
|
|
|
|
|
|
my $numberelts = scalar(@eltstemp); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
#my @sorted = sort { (split(/,/, $b))[$#eltstemp] <=> (split(/,/, $a))[$#eltstemp] } @lines; |
464
|
0
|
|
|
|
|
|
my @sorted = sort { (split(/,/, $a))[$#eltstemp] <=> (split(/,/, $b))[$#eltstemp] } @lines; |
|
0
|
|
|
|
|
|
|
465
|
0
|
|
|
|
|
|
for (my $h = 0; $h <= $#sorted; ++$h) |
466
|
|
|
|
|
|
|
{ |
467
|
0
|
|
|
|
|
|
$sorted[$h] =~ s/^,//; |
468
|
0
|
|
|
|
|
|
print SORTMIXED_ $sorted[$h]; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
#if ($numberelts > 0) { print SORTMIXED_ `sort -t, -k$numberelts -n $weighttwo`; } |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
#my @sorted = sort { $b->[1] <=> $a->[1] } @lines; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
#print SORTMIXED_ map $_->[0], |
476
|
|
|
|
|
|
|
#sort { $a->[$#eltstemp] <=> $b->[$#eltstemp] } |
477
|
|
|
|
|
|
|
#map { [ [ @lines ] , /,/ ] } |
478
|
|
|
|
|
|
|
#foreach my $elt (@sorted) |
479
|
|
|
|
|
|
|
#{ |
480
|
|
|
|
|
|
|
# print SORTMIXED "$elt"; |
481
|
|
|
|
|
|
|
#} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
#if ($numberelts > 0) { print SORTMIXED_ `sort -n -k$numberelts,$numberelts -t , $weighttwo`; } ### ZZZ |
484
|
|
|
|
|
|
|
# print SORTMIXED_ `sort -n -k$numberelts -n $weighttwo`; |
485
|
0
|
|
|
|
|
|
close SORTMIXED_; |
486
|
|
|
|
|
|
|
} |
487
|
0
|
|
|
|
|
|
&sortmixed; |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
########################################################## |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
sub takeoptima |
492
|
|
|
|
|
|
|
{ |
493
|
|
|
|
|
|
|
#my $pass_signal = ""; # IF VOID, GAUSS SEIDEL METHOD. IF 0, JACOBI METHOD. ... |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
#say TOSHELL `cat $sortmixed`; |
496
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA cat \$sortmixed: $sortmixed"; |
497
|
|
|
|
|
|
|
|
498
|
0
|
|
|
0
|
0
|
|
open (SORTMIXED_, $sortmixed); # or die; |
499
|
0
|
|
|
|
|
|
my @lines = ; |
500
|
0
|
|
|
|
|
|
close SORTMIXED_; |
501
|
|
|
|
|
|
|
|
502
|
0
|
|
|
|
|
|
my $winnerentry = $lines[0]; #say TOSHELL "dump(TAKEOPTIMA\$winnerentry): " . dump($winnerentry); |
503
|
0
|
|
|
|
|
|
chomp $winnerentry; |
504
|
|
|
|
|
|
|
|
505
|
0
|
|
|
|
|
|
my @winnerelms = split(/\s+|,/, $winnerentry); |
506
|
0
|
|
|
|
|
|
my $winnerline = $winnerelms[0]; #say TOSHELL "dump(TAKEOPTIMA\$winnerline): " . dump($winnerline); |
507
|
0
|
|
|
|
|
|
my $winnerval = $winnerelms[$#winnerelms]; |
508
|
0
|
|
|
|
|
|
push ( @{ $uplift[$countcase][$countblock] }, $winnerval); #say TOSHELL "TAKEOPTIMA->\@winneritems " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
0
|
|
|
|
|
|
my $cntelm = 0; |
511
|
0
|
|
|
|
|
|
open ( MESSAGE, ">>$mypath/attention.txt"); |
512
|
0
|
|
|
|
|
|
foreach my $elm (@lines) |
513
|
|
|
|
|
|
|
{ |
514
|
0
|
|
|
|
|
|
my @lineelms = split( /\s+|,/, $elm ); |
515
|
0
|
|
|
|
|
|
my $val = $lineelms[$#lineelms]; |
516
|
0
|
|
|
|
|
|
my $case = $lineelms[0]; |
517
|
|
|
|
|
|
|
{ |
518
|
0
|
0
|
|
|
|
|
if ($cnelm > 0) |
|
0
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
{ |
520
|
0
|
0
|
|
|
|
|
if ( $val == $winnerval) |
521
|
|
|
|
|
|
|
{ |
522
|
0
|
|
|
|
|
|
say MESSAGE "Attention. At case $countcaseplus, block $contblocksplus. There is a tie between optimal cases. Besides case $winnerline, producing a compound objective function of $winnerval, there is the case $case producing the same objective function value. Case $winnerline has been used for the search procedures which follow.\n"; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
} |
526
|
0
|
|
|
|
|
|
$cnelm++; |
527
|
|
|
|
|
|
|
} |
528
|
0
|
|
|
|
|
|
close (MESSAGE); |
529
|
|
|
|
|
|
|
|
530
|
0
|
|
|
|
|
|
my $copy = $winnerline; |
531
|
0
|
|
|
|
|
|
$copy =~ s/$mypath\/$file//; |
532
|
0
|
|
|
|
|
|
my @taken = Sim::OPT::extractcase("$copy", \%mids); #say TOSHELL "TAKEOPTIMA--->taken: " . dump(@taken); |
533
|
0
|
|
|
|
|
|
my $newtarget = $taken[0]; #say TOSHELL "TAKEOPTIMA\$newtarget--->: $newtarget"; |
534
|
0
|
|
|
|
|
|
$newtarget =~ s/$mypath\///; |
535
|
0
|
|
|
|
|
|
my %newcarrier = %{$taken[1]}; #say TOSHELL "TAKEOPTIMA\%newcarrier--->" . dump(%newcarrier); |
|
0
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA BEFORE->\@miditers: " . dump(@miditers); |
537
|
0
|
|
|
|
|
|
%{ $miditers[$countcase] } = %newcarrier; #say TOSHELL "TAKEOPTIMA AFTER->\@miditers: " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
#say "2\$countcase : " . dump($countcase); |
540
|
|
|
|
|
|
|
#say "2\@rootnames : " . dump(@rootnames); |
541
|
|
|
|
|
|
|
#say "2\$countblock : " . dump($countblock); |
542
|
|
|
|
|
|
|
#say "2\@sweeps : " . dump(@sweeps); |
543
|
|
|
|
|
|
|
#say "2\@varinumbers : " . dump(@varinumbers); |
544
|
|
|
|
|
|
|
#say "2\@miditers : " . dump(@miditers); |
545
|
|
|
|
|
|
|
#say "2\@winneritems : " . dump(@winneritems); |
546
|
|
|
|
|
|
|
#say "2\@morphcases : " . dump(@morphcases); |
547
|
|
|
|
|
|
|
#say "2\@morphstruct : " . dump(@morphstruct); |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\$countcase " . dump($countcase); |
550
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\$countblock " . dump($countblock); |
551
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\@miditers " . dump(@miditers); |
552
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\@winneritems " . dump(@winneritems); |
553
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\%dirfiles " . dump(%dirfiles); |
554
|
|
|
|
|
|
|
#say TOSHELL "TAKEOPTIMA FINAL ->\@uplift " . dump(@uplift); |
555
|
|
|
|
|
|
|
|
556
|
0
|
|
|
|
|
|
$countblock++; ### !!! |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
#say $tee "TAKEOPTIMA FINAL ->\$countblock " . dump($countblock); |
559
|
|
|
|
|
|
|
#say $tee "TAKEOPTIMA FINAL ->\scalar( \@blocks ) " . dump( scalar( @blocks ) ); |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# STOP CONDITION |
562
|
0
|
0
|
|
|
|
|
if ( $countblock == scalar( @blocks ) ) # NUMBER OF BLOCK OF THE CURRENT CASE |
563
|
|
|
|
|
|
|
{ |
564
|
|
|
|
|
|
|
#say $tee "TAKEOPTIMA FINAL ->\$countblock " . dump($countblock); |
565
|
|
|
|
|
|
|
#say $tee "TAKEOPTIMA FINAL ->\$countblock " . dump($countblock); |
566
|
0
|
|
|
|
|
|
my @morphcases = grep -d, <$mypath/$file_*>; |
567
|
0
|
|
|
|
|
|
say $tee "#Optimal option for case $countcaseplus: $newtarget"; |
568
|
|
|
|
|
|
|
#my $instnum = Sim::OPT::countarray( @{ $morphstruct[$countcase] } ); |
569
|
|
|
|
|
|
|
#say $tee "#Gross number of instances: $instnum." ; |
570
|
0
|
|
|
|
|
|
my $netinstnum = scalar(@morphcases); |
571
|
0
|
|
|
|
|
|
say $tee "#Net number of instances: $netinstnum." ; |
572
|
0
|
|
|
|
|
|
open( RESPONSE , ">$mypath/response.txt"); |
573
|
0
|
|
|
|
|
|
say RESPONSE "#Optimal option for case $countcaseplus: $newtarget"; |
574
|
|
|
|
|
|
|
#say RESPONSE "#Gross number of instances: $instnum." ; |
575
|
0
|
|
|
|
|
|
say RESPONSE "#Net number of instances: $netinstnum." ; |
576
|
|
|
|
|
|
|
|
577
|
0
|
|
|
|
|
|
$countblock = 0; |
578
|
0
|
|
|
|
|
|
$countcase = $countcase++; |
579
|
0
|
0
|
|
|
|
|
if ( $countcase == scalar( @sweeps ) )# NUMBER OF CASES OF THE CURRENT PROBLEM |
580
|
|
|
|
|
|
|
{ |
581
|
0
|
|
|
|
|
|
exit (say $tee "#END RUN."); |
582
|
|
|
|
|
|
|
} |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
else |
585
|
|
|
|
|
|
|
{ |
586
|
0
|
|
|
|
|
|
push ( @{ $winneritems[$countcase][$countblock] }, $newtarget); #say TOSHELL "TAKEOPTIMA->\@winneritems " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
587
|
0
|
|
|
|
|
|
Sim::OPT::callcase( { countcase => $countcase, countblock => $countblock, |
588
|
|
|
|
|
|
|
miditers => \@miditers, winneritems => \@winneritems, |
589
|
|
|
|
|
|
|
dirfiles => \%dirfiles, uplift => \@uplift } ); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
} |
592
|
0
|
|
|
|
|
|
&takeoptima(); |
593
|
0
|
|
|
|
|
|
close OUTFILE; |
594
|
0
|
|
|
|
|
|
close TOSHELL; |
595
|
|
|
|
|
|
|
} # END SUB descend |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
1; |