| 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; |