line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sim::OPT; |
2
|
|
|
|
|
|
|
# Copyright (C) 2008-2015 by Gian Luca Brunetti and Politecnico di Milano. |
3
|
|
|
|
|
|
|
# This is Sim::OPT, a program for detailed metadesign of buildings 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
|
|
20216
|
use v5.14; |
|
1
|
|
|
|
|
4
|
|
7
|
|
|
|
|
|
|
# use v5.20; |
8
|
1
|
|
|
1
|
|
4
|
use Exporter; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
93
|
|
9
|
1
|
|
|
1
|
|
585
|
use parent 'Exporter'; # imports and subclasses Exporter |
|
1
|
|
|
|
|
346
|
|
|
1
|
|
|
|
|
6
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
56
|
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
12
|
1
|
|
|
1
|
|
4097
|
use Math::Trig; |
|
1
|
|
|
|
|
26649
|
|
|
1
|
|
|
|
|
249
|
|
13
|
1
|
|
|
1
|
|
856
|
use Math::Round; |
|
1
|
|
|
|
|
10757
|
|
|
1
|
|
|
|
|
83
|
|
14
|
1
|
|
|
1
|
|
9
|
use List::Util qw[ min max reduce shuffle]; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
122
|
|
15
|
1
|
|
|
1
|
|
921
|
use List::MoreUtils qw(uniq); |
|
1
|
|
|
|
|
14253
|
|
|
1
|
|
|
|
|
11
|
|
16
|
1
|
|
|
1
|
|
1482
|
use List::AllUtils qw(sum); |
|
1
|
|
|
|
|
4609
|
|
|
1
|
|
|
|
|
129
|
|
17
|
1
|
|
|
1
|
|
789
|
use Statistics::Basic qw(:all); |
|
1
|
|
|
|
|
11166
|
|
|
1
|
|
|
|
|
5
|
|
18
|
1
|
|
|
1
|
|
23502
|
use IO::Tee; |
|
1
|
|
|
|
|
11473
|
|
|
1
|
|
|
|
|
48
|
|
19
|
1
|
|
|
1
|
|
722
|
use Set::Intersection; |
|
1
|
|
|
|
|
345
|
|
|
1
|
|
|
|
|
70
|
|
20
|
1
|
|
|
1
|
|
1022
|
use List::Compare; |
|
1
|
|
|
|
|
18377
|
|
|
1
|
|
|
|
|
38
|
|
21
|
1
|
|
|
1
|
|
788
|
use Data::Dumper; |
|
1
|
|
|
|
|
8484
|
|
|
1
|
|
|
|
|
116
|
|
22
|
|
|
|
|
|
|
#$Data::Dumper::Indent = 0; |
23
|
|
|
|
|
|
|
#$Data::Dumper::Useqq = 1; |
24
|
|
|
|
|
|
|
#$Data::Dumper::Terse = 1; |
25
|
1
|
|
|
1
|
|
780
|
use Data::Dump qw(dump); |
|
1
|
|
|
|
|
6818
|
|
|
1
|
|
|
|
|
104
|
|
26
|
1
|
|
|
1
|
|
12
|
use feature 'say'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
131
|
|
27
|
|
|
|
|
|
|
#use feature qw(postderef); |
28
|
|
|
|
|
|
|
#no warnings qw(experimental::postderef); |
29
|
|
|
|
|
|
|
#use Sub::Signatures; |
30
|
|
|
|
|
|
|
#no warnings qw(Sub::Signatures); |
31
|
|
|
|
|
|
|
#no strict 'refs'; |
32
|
1
|
|
|
1
|
|
7
|
no strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
33
|
1
|
|
|
1
|
|
5
|
no warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
34
|
|
|
|
|
|
|
|
35
|
1
|
|
|
1
|
|
1197
|
use Sim::OPT::Morph; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
205
|
|
36
|
1
|
|
|
1
|
|
9
|
use Sim::OPT::Sim; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
39
|
|
37
|
1
|
|
|
1
|
|
4
|
use Sim::OPT::Retrieve; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
44
|
|
38
|
1
|
|
|
1
|
|
4
|
use Sim::OPT::Report; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
37
|
|
39
|
1
|
|
|
1
|
|
3
|
use Sim::OPT::Descend; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
33
|
|
40
|
1
|
|
|
1
|
|
4
|
use Sim::OPT::Takechance; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
40
|
|
41
|
1
|
|
|
1
|
|
603
|
use Sim::OPT::Parcoord3d; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
6884
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
our @ISA = qw(Exporter); # our @adamkISA = qw(Exporter); |
44
|
|
|
|
|
|
|
#%EXPORT_TAGS = ( DEFAULT => [qw( &opt &prepare )]); # our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); |
45
|
|
|
|
|
|
|
#@EXPORT_OK = qw(); # our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
our @EXPORT = qw( |
48
|
|
|
|
|
|
|
opt takechance |
49
|
|
|
|
|
|
|
odd even _mean_ flattenvariables count_variables fromopt_tosweep fromsweep_toopt convcaseseed |
50
|
|
|
|
|
|
|
convchanceseed makeflatvarnsnum calcoverlaps calcmediumiters getitersnum definerootcases |
51
|
|
|
|
|
|
|
callcase callblocks deffiles makefilename extractcase setlaunch exe start |
52
|
|
|
|
|
|
|
_clean_ getblocks getblockelts getrootname definerootcases populatewinners |
53
|
|
|
|
|
|
|
getitem getline getlines getcase getstepsvar tell wash flattenbox enrichbox filterbox givesize |
54
|
|
|
|
|
|
|
$configfile $mypath $exeonfiles $generatechance $file $preventsim $fileconfig $outfile $toshell $report |
55
|
|
|
|
|
|
|
$simnetwork @themereports @simtitles @reporttitles @simdata @retrievedata |
56
|
|
|
|
|
|
|
@keepcolumns @weights @weightsaim @varthemes_report @varthemes_variations @varthemes_steps |
57
|
|
|
|
|
|
|
@rankdata @rankcolumn @reporttempsdata @reportcomfortdata @reportradiationenteringdata |
58
|
|
|
|
|
|
|
@report_loadsortemps @files_to_filter @filter_reports @base_columns @maketabledata @filter_columns |
59
|
|
|
|
|
|
|
@files_to_filter @filter_reports @base_columns @maketabledata @filter_columns %vals |
60
|
|
|
|
|
|
|
@sweeps @mediumiters @varinumbers @caseseed @chanceseed @chancedata $dimchance $tee @pars_tocheck |
61
|
|
|
|
|
|
|
$target |
62
|
|
|
|
|
|
|
); # our @EXPORT = qw( ); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
$VERSION = '0.40.14'; # our $VERSION = ''; |
65
|
|
|
|
|
|
|
$ABSTRACT = 'Sim::OPT it a tool for detailed metadesign. It manages parametric explorations through the ESP-r building performance simulation platform and performs optimization by block coordinate descent.'; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
################################################################################# |
68
|
|
|
|
|
|
|
# Sim::OPT |
69
|
|
|
|
|
|
|
################################################################################# |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# FUNCTIONS' SPACE |
72
|
|
|
|
|
|
|
########################################################### |
73
|
|
|
|
|
|
|
########################################################### |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub odd |
76
|
|
|
|
|
|
|
{ |
77
|
0
|
|
|
0
|
0
|
|
my $number = shift; |
78
|
0
|
|
|
|
|
|
return !even ($number); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub even |
82
|
|
|
|
|
|
|
{ |
83
|
0
|
|
|
0
|
0
|
|
my $number = abs shift; |
84
|
0
|
0
|
|
|
|
|
return 1 if $number == 0; |
85
|
0
|
|
|
|
|
|
return odd ($number - 1); |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
0
|
0
|
|
0
|
|
|
sub _mean_ { return @_ ? sum(@_) / @_ : 0 } |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub countarray |
92
|
|
|
|
|
|
|
{ |
93
|
0
|
|
|
0
|
0
|
|
my $c = 1; |
94
|
0
|
|
|
|
|
|
foreach (@_) |
95
|
|
|
|
|
|
|
{ |
96
|
0
|
|
|
|
|
|
foreach (@$_) |
97
|
|
|
|
|
|
|
{ |
98
|
0
|
|
|
|
|
|
$c++; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
} |
101
|
0
|
|
|
|
|
|
return ($c); # TO BE CALLED WITH: countarray(@array) |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub countnetarray |
105
|
|
|
|
|
|
|
{ |
106
|
0
|
|
|
0
|
0
|
|
my @bag; |
107
|
0
|
|
|
|
|
|
foreach (@_) |
108
|
|
|
|
|
|
|
{ |
109
|
0
|
|
|
|
|
|
foreach (@$_) |
110
|
|
|
|
|
|
|
{ |
111
|
0
|
|
|
|
|
|
push (@bag, $_); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
0
|
|
|
|
|
|
@bag = uniq(@bag); |
115
|
0
|
|
|
|
|
|
return scalar(@bag); # TO BE CALLED WITH: countnetarray(@array) |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub sorttable # TO SORT A TABLE ON THE BASIS OF A COLUMN |
119
|
|
|
|
|
|
|
{ |
120
|
0
|
|
|
0
|
0
|
|
my $num = $_[0]; |
121
|
0
|
|
|
|
|
|
my @table = @{ $_[1] }; |
|
0
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my @rows; |
123
|
0
|
|
|
|
|
|
foreach my $line (@table) |
124
|
|
|
|
|
|
|
{ |
125
|
0
|
|
|
|
|
|
chomp $line; |
126
|
0
|
|
|
|
|
|
$sth->execute(line); |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
my @row = $sth->fetchrow_array; |
129
|
0
|
|
|
|
|
|
unshift (@row, $line); |
130
|
0
|
|
|
|
|
|
push @rows, \@row; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
@rows = sort { $a->[$num] cmp $b->[$num] } @rows; |
|
0
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
foreach my $row (@rows) { |
136
|
0
|
|
|
|
|
|
foreach (@$row) { |
137
|
0
|
|
|
|
|
|
print "$_"; |
138
|
|
|
|
|
|
|
} |
139
|
0
|
|
|
|
|
|
print "\n"; |
140
|
|
|
|
|
|
|
} #TO BE CALLED WITH: sorttable( $number_of column, \@table); |
141
|
0
|
|
|
|
|
|
return (@table); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub _clean_ |
145
|
|
|
|
|
|
|
{ # IT CLEANS A BASKET FROM CASES LIKE "-", "1-", "-1", "". |
146
|
0
|
|
|
0
|
|
|
my $swap = shift; |
147
|
0
|
|
|
|
|
|
my @arraytoclean = @$swap; |
148
|
0
|
|
|
|
|
|
my @storeinfo; |
149
|
0
|
|
|
|
|
|
foreach (@arraytoclean) |
150
|
|
|
|
|
|
|
{ |
151
|
0
|
|
|
|
|
|
$_ =~ s/ //; |
152
|
0
|
0
|
0
|
|
|
|
unless ( !( defined $_) or ($_ =~ /^-/) or ($_ =~ /-$/) or ($_ =~ /^-$/) or ($_ eq "") or ($_ eq "-") ) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
153
|
|
|
|
|
|
|
{ |
154
|
0
|
|
|
|
|
|
push(@storeinfo, $_) |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
0
|
|
|
|
|
|
return @storeinfo; # HOW TO CALL THIS FUNCTION: clean(\@arraytoclean). IT IS DESTRUCTIVE. |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub present |
161
|
|
|
|
|
|
|
{ |
162
|
0
|
|
|
0
|
0
|
|
foreach (@_) |
163
|
|
|
|
|
|
|
{ |
164
|
0
|
|
|
|
|
|
say "### $_ : " . dump($_); |
165
|
0
|
|
|
|
|
|
say TOSHELL "### $_ : " . dump($_); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub flattenvariables # IT LISTS THE NUMBER OF VARIABLES PLAY IN A LIST OF BLOCK SEARCHES. ONE COUNT FOR EACH LIST ELEMENT. |
171
|
|
|
|
|
|
|
{ |
172
|
0
|
|
|
0
|
0
|
|
my @array = @_; |
173
|
0
|
|
|
|
|
|
foreach my $case (@array) |
174
|
|
|
|
|
|
|
{ |
175
|
0
|
|
|
|
|
|
@casederef = @$case; |
176
|
0
|
|
|
|
|
|
my @basket; |
177
|
0
|
|
|
|
|
|
foreach my $block (@casederef) |
178
|
|
|
|
|
|
|
{ |
179
|
0
|
|
|
|
|
|
@blockelts = @$block; |
180
|
0
|
|
|
|
|
|
push (@basket, @blockelts); |
181
|
|
|
|
|
|
|
} |
182
|
0
|
|
|
|
|
|
my @basket = sort { $a <=> $b} uniq(@basket); |
|
0
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
push ( @flatvarns, \@basket ); ### |
184
|
|
|
|
|
|
|
# IT HAS TO BE CALLED WITH: flatten_variables(@treeseed); |
185
|
|
|
|
|
|
|
} # say "\@NUMVARNS!: " . dump(@numvarns); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub count_variables # IT COUNTS THE FLATTENED VARIABLES |
189
|
|
|
|
|
|
|
{ |
190
|
0
|
|
|
0
|
0
|
|
my @flatvarns = @_; |
191
|
0
|
|
|
|
|
|
foreach my $group (@flatvarns) |
192
|
|
|
|
|
|
|
{ |
193
|
0
|
|
|
|
|
|
my @array = @$group; |
194
|
0
|
|
|
|
|
|
push ( @flatvarnsnum, scalar(@array) ); |
195
|
|
|
|
|
|
|
# IT HAS TO BE CALLED WITH: count_variables(@flatvarns); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# flatten_variables ( [ [1, 2, 3] , [2, 3, 4] , [3, 4, 5] ], [ [1, 2], [2, 3] ] ); |
200
|
|
|
|
|
|
|
#count_variables ([1, 2, 3, 4, 5], [1, 2, 3]); |
201
|
|
|
|
|
|
|
#say "COUNTFLATTENEDVARNS: @countflattenedvarns"; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub fromopt_tosweep # IT CONVERTS A TREE BLOCK SEARCH FORMAT IN THE ORIGINAL OPT'S BLOCKS SEARCH FORMAT. |
204
|
|
|
|
|
|
|
{ |
205
|
0
|
|
|
0
|
0
|
|
my %thishash = %{ $_[0] }; #say "dump(%thishash): " . dump(%thishash); |
|
0
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
my @casegroup = @{ $thishash{casegroup} } ; #say "dump(\@casegroup): " . dump(@casegroup); |
|
0
|
|
|
|
|
|
|
207
|
0
|
|
|
|
|
|
my @chancegroup = @{ $thishash{chancegroup} }; #say "dump(\@chancegroup): " . dump(@chancegroup); |
|
0
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
|
my @sweeps; |
209
|
0
|
|
|
|
|
|
my $countcase = 0; |
210
|
0
|
|
|
|
|
|
foreach my $case (@casegroup) |
211
|
|
|
|
|
|
|
{ |
212
|
0
|
|
|
|
|
|
my @blockrefs = @$case; #say "dump(\@blocks): " . dump(@blocks); |
213
|
0
|
|
|
|
|
|
my @chancerefs = @{ $chancegroup[$countcase] }; #say "dump(\@chancerefs): " . dump(@chancerefs); |
|
0
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
my @sweepblocks; |
215
|
0
|
|
|
|
|
|
my $countblock = 0; |
216
|
0
|
|
|
|
|
|
foreach my $elt (@blockrefs) |
217
|
|
|
|
|
|
|
{ |
218
|
0
|
|
|
|
|
|
my @blockelts = @$elt; #say "dump(\@blockelts): " . dump(@blockelts); |
219
|
0
|
|
|
|
|
|
my $attachpoint = $blockelts[0]; #say "attachpoint: $attachpoint"; |
220
|
0
|
|
|
|
|
|
my $blocklength = $blockelts[1]; #say "blocklength: $blocklength"; |
221
|
0
|
|
|
|
|
|
my @chances = @{ $chancerefs[$countblock] }; # say "dump(\@chancerefs): " . dump(@chancerefs); |
|
0
|
|
|
|
|
|
|
222
|
0
|
|
|
|
|
|
my @sweepblock = @chances[ $attachpoint .. ($attachpoint + $blocklength - 1) ]; #say "dump(\@sweepblock): " . dump(@sweepblock); |
223
|
0
|
|
|
|
|
|
push (@sweepblocks, [@sweepblock]); |
224
|
0
|
|
|
|
|
|
$countblock++; |
225
|
|
|
|
|
|
|
} |
226
|
0
|
|
|
|
|
|
push (@sweeps, [ @sweepblocks ] ); |
227
|
0
|
|
|
|
|
|
$countcase++; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
# IT HAS TO BE CALLED THIS WAY: fromopt_tosweep( { casegroup => \@caseseed, chancegroup => \@chanceseed } ); |
230
|
0
|
|
|
|
|
|
return (@sweeps); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub fromopt_tosweep_simple # IT CONVERTS A TREE BLOCK SEARCH FORMAT IN THE ORIGINAL OPT'S BLOCKS SEARCH FORMAT. |
234
|
|
|
|
|
|
|
{ |
235
|
0
|
|
|
0
|
0
|
|
my %thishash = @_; #say "dump(%thishash): " . dump(%thishash); |
236
|
0
|
|
|
|
|
|
my $casegroupref = $thishash{casegroup}; |
237
|
0
|
|
|
|
|
|
my @blocks = @$casegroupref; #say "dump(\@casegroup): " . dump(@casegroup); |
238
|
0
|
|
|
|
|
|
my $chancegroupref = $thishash{chancegroup}; |
239
|
0
|
|
|
|
|
|
my @chances = @$chancegroupref; #say "dump(\@chancegroup): " . dump(@chancegroup); |
240
|
0
|
|
|
|
|
|
my $countblock = 0; |
241
|
0
|
|
|
|
|
|
foreach my $elt (@blocks) |
242
|
|
|
|
|
|
|
{ |
243
|
0
|
|
|
|
|
|
my @blockelts = @$elt; #say "dump(\@blockelts): " . dump(@blockelts); |
244
|
0
|
|
|
|
|
|
my $attachpoint = $blockelts[0]; #say "attachpoint: $attachpoint"; |
245
|
0
|
|
|
|
|
|
my $blocklength = $blockelts[1]; #say "blocklength: $blocklength"; |
246
|
0
|
|
|
|
|
|
my $chancesref = $chances[$countblock]; # say "dump(\$chancesref): " . dump($chancesref); |
247
|
0
|
|
|
|
|
|
my @chances = @$chancesref; #say "dump(\@chances): " . dump(@chances); |
248
|
0
|
|
|
|
|
|
my @sweepblock = @chances[ $attachpoint .. ($attachpoint + $blocklength - 1) ]; #say "dump(\@sweepblock): " . dump(@sweepblock); |
249
|
0
|
|
|
|
|
|
push (@sweepblocks, [@sweepblock]); |
250
|
0
|
|
|
|
|
|
$countblock++; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
# IT HAS TO BE CALLED THIS WAY: fromopt_tosweep( casegroup => [@caserefs_alias], chancegroup => [@chancerefs_alias] ); # IT IS NOT RELATIVE TO CASE: JUST ONE CASE, THE CURRENT. |
253
|
0
|
|
|
|
|
|
return (@sweepblocks); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub checkduplicates |
257
|
|
|
|
|
|
|
{ |
258
|
0
|
|
|
0
|
0
|
|
my %hash = %{$_[0]}; |
|
0
|
|
|
|
|
|
|
259
|
0
|
|
|
|
|
|
my @slice = @{$hash{slice}}; |
|
0
|
|
|
|
|
|
|
260
|
0
|
|
|
|
|
|
my @sweepblocks = @{$hash{sweepblocks}}; |
|
0
|
|
|
|
|
|
|
261
|
0
|
|
|
|
|
|
my $signal = 0; |
262
|
0
|
|
|
|
|
|
foreach my $blockref (@sweepblocks) |
263
|
|
|
|
|
|
|
{ |
264
|
0
|
|
|
|
|
|
@block = @$blockref; |
265
|
0
|
0
|
|
|
|
|
if ( @slice ~~ @block ) |
266
|
|
|
|
|
|
|
{ |
267
|
0
|
|
|
|
|
|
$signal++; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
} |
270
|
0
|
0
|
|
|
|
|
if ($signal == 0) { return "no"; } |
|
0
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
else { return "yes" }; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub fromsweep_toopt # IT CONVERTS THE ORIGINAL OPT'S BLOCKS SEARCH FORMAT IN A TREE BLOCK SEARCH FORMAT. |
275
|
|
|
|
|
|
|
{ |
276
|
0
|
|
|
0
|
0
|
|
my ( @bucket, @secondbucket ); |
277
|
0
|
|
|
|
|
|
my $countcase = 0; |
278
|
0
|
|
|
|
|
|
foreach (@_) # CASES |
279
|
|
|
|
|
|
|
{ |
280
|
0
|
|
|
|
|
|
my ( @blocks, @chances ); |
281
|
0
|
|
|
|
|
|
my $countblock = 0; |
282
|
0
|
|
|
|
|
|
foreach(@$_) # BLOCKS |
283
|
|
|
|
|
|
|
{ |
284
|
|
|
|
|
|
|
#say "dump(\@\$_): " . dump(@$_); |
285
|
0
|
|
|
|
|
|
my $swap = $flatvarns[$countcase]; |
286
|
0
|
|
|
|
|
|
my @varns = @$swap; #say "dump(\@varns): " . dump(@varns); |
287
|
0
|
|
|
|
|
|
my @block = @$_; |
288
|
0
|
|
|
|
|
|
my $blocksize = scalar(@block); |
289
|
0
|
|
|
|
|
|
my $lc = List::Compare->new(\@varns, \@block); |
290
|
0
|
|
|
|
|
|
my @intersection = $lc->get_intersection; #say "dump(\@intersection): " . dump(@intersection); |
291
|
0
|
|
|
|
|
|
my @nonbelonging; |
292
|
0
|
|
|
|
|
|
foreach (@varns) |
293
|
|
|
|
|
|
|
{ |
294
|
0
|
|
|
|
|
|
my @parlist; |
295
|
0
|
0
|
|
|
|
|
unless ($_ ~~ @intersection) |
296
|
|
|
|
|
|
|
{ |
297
|
0
|
|
|
|
|
|
push (@nonbelonging, $_); |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
#say "dump(\@nonbelonging): " . dump(@nonbelonging); |
301
|
0
|
|
|
|
|
|
push (@blocks, [@intersection, @nonbelonging] ); # say "dump(\@blocks): " . dump(@blocks); |
302
|
0
|
|
|
|
|
|
push (@chances, [0, $blocksize] ); |
303
|
0
|
|
|
|
|
|
$countblock++; |
304
|
|
|
|
|
|
|
} |
305
|
0
|
|
|
|
|
|
push (@bucket, [ @blocks ] ); |
306
|
0
|
|
|
|
|
|
push (@secondbucket, [@chances]); |
307
|
0
|
|
|
|
|
|
$countcase++; |
308
|
|
|
|
|
|
|
} |
309
|
0
|
|
|
|
|
|
@chanceseed = @bucket; |
310
|
0
|
|
|
|
|
|
@caseseed = @secondbucket; |
311
|
0
|
|
|
|
|
|
return (\@caseseed, \@chanceseed); |
312
|
|
|
|
|
|
|
# IT HAS TO BE CALLED THIS WAY: fromsweep_toopt(@sweep); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub convcaseseed # IT ADEQUATES THE POINT OF ATTACHMENT OF EACH BLOCK TO THE FACT THAT THE LISTS CONSTITUING THEM ARE THREE, JOINED. |
316
|
|
|
|
|
|
|
{ |
317
|
0
|
|
|
0
|
0
|
|
my $ref = shift; |
318
|
0
|
|
|
|
|
|
my %hash = %{$ref}; |
|
0
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
my @chanceseed = @{ $hash{ chanceseed } }; #say $tee "IN\@chanceseed:" . dump(@chanceseed); |
|
0
|
|
|
|
|
|
|
320
|
0
|
|
|
|
|
|
my @caseseed = @{ $hash{ caseseed } }; #say $tee "IN\@caseseed:" . dump(@caseseed); |
|
0
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
|
my $countcase = 0; |
322
|
0
|
|
|
|
|
|
foreach $case (@caseseed) |
323
|
|
|
|
|
|
|
{ |
324
|
0
|
|
|
|
|
|
my $chance = $chanceseed[$countcase]; |
325
|
0
|
|
|
|
|
|
my $countblock = 0; |
326
|
0
|
|
|
|
|
|
my @blockrefs = @$case; |
327
|
0
|
|
|
|
|
|
my @chancerefs = @$chance; |
328
|
0
|
|
|
|
|
|
foreach (@blockrefs) |
329
|
|
|
|
|
|
|
{ |
330
|
0
|
|
|
|
|
|
my $chancelt = scalar ( @{ $chancerefs[$countblock] } ); #say $tee "IN\$chancerefs\[\$countblock]" . dump($chancerefs[$countblock]); say $tee "IN\$chancelt" . dump($chancelt); |
|
0
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
my $numofelts = ( $chancelt / 3 ); #say $tee "IN\$numofelts" . dump($numofelts); |
332
|
0
|
|
|
|
|
|
${$_}[0] = ${$_}[0] + $numofelts; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
$countblock++; |
334
|
|
|
|
|
|
|
} |
335
|
0
|
|
|
|
|
|
$countcase++; |
336
|
|
|
|
|
|
|
} # TO BE CALLED WITH: convcaseseed(\@caseseed, \@chanceseed). @caseseed IS globsAL. TO BE CALLED WITH: convcaseseed(@caseseed); |
337
|
0
|
|
|
|
|
|
return(@caseseed); |
338
|
|
|
|
|
|
|
} |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub convchanceseed # IT COUNTS HOW MANY PARAMETERS THERE ARE IN A SEARCH STRUCTURE, |
342
|
|
|
|
|
|
|
{ |
343
|
0
|
|
|
0
|
0
|
|
foreach (@_) |
344
|
|
|
|
|
|
|
{ |
345
|
0
|
|
|
|
|
|
foreach (@$_) |
346
|
|
|
|
|
|
|
{ |
347
|
0
|
|
|
|
|
|
push (@$_, @$_, @$_); #say "\@\$_ @$_"; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
} # IT HAS TO BE CALLED WITH convchanceseed(@chanceseed). IT ACTS ON @chanceseed, WHICH IS globsAL. |
350
|
0
|
|
|
|
|
|
return(@_); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
sub tellnum |
354
|
|
|
|
|
|
|
{ |
355
|
0
|
|
|
0
|
0
|
|
@arr = @_; |
356
|
0
|
|
|
|
|
|
my $response = (scalar(@_)/2); |
357
|
0
|
|
|
|
|
|
return($response); # TO BE CALLED WITH tellnum(%varnums); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub calcoverlaps |
361
|
|
|
|
|
|
|
{ |
362
|
0
|
|
|
0
|
0
|
|
my $countcase = 0; |
363
|
0
|
|
|
|
|
|
foreach my $case(@sweeps) |
364
|
|
|
|
|
|
|
{ |
365
|
0
|
|
|
|
|
|
my @caseelts = @{$case}; |
|
0
|
|
|
|
|
|
|
366
|
0
|
|
|
|
|
|
my $contblock = 0; |
367
|
0
|
|
|
|
|
|
my @overlaps; |
368
|
0
|
|
|
|
|
|
foreach my $block (@caseelts) |
369
|
|
|
|
|
|
|
{ |
370
|
0
|
|
|
|
|
|
my @pasttblock = @{$block[ $contblock - 1 ]}; |
|
0
|
|
|
|
|
|
|
371
|
0
|
|
|
|
|
|
my @presentblock = @{$block[ $contblock ]}; |
|
0
|
|
|
|
|
|
|
372
|
0
|
|
|
|
|
|
my $lc = List::Compare->new(\@pasttblock, \@presentblock); |
373
|
0
|
|
|
|
|
|
my @intersection = $lc->get_intersection; #say "dump(\@intersection): " . dump(@intersection); |
374
|
0
|
|
|
|
|
|
push (@caseoverlaps, [ @intersection ] ); |
375
|
0
|
|
|
|
|
|
$countblock++; |
376
|
|
|
|
|
|
|
} |
377
|
0
|
|
|
|
|
|
push (@casesoverlaps, [@overlaps]); # globsAL! |
378
|
0
|
|
|
|
|
|
$countcase++; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
sub calcmediumiters |
383
|
|
|
|
|
|
|
{ |
384
|
0
|
|
|
0
|
0
|
|
my @varinumbers = @_; |
385
|
0
|
|
|
|
|
|
my $countcase = 0; |
386
|
0
|
|
|
|
|
|
my @mediumiters; |
387
|
0
|
|
|
|
|
|
foreach ( @varinumbers ) |
388
|
|
|
|
|
|
|
{ |
389
|
0
|
|
|
|
|
|
my $countblock = 0; |
390
|
0
|
|
|
|
|
|
foreach (keys %$_) |
391
|
|
|
|
|
|
|
{ |
392
|
|
|
|
|
|
|
#say "inner dump (\$_): " . dump ($_); |
393
|
|
|
|
|
|
|
#say "dumpalias (\$varinumbers[\$countcase]{\$_}): " . dump ($varinumbers[$countcase]{$_}); |
394
|
0
|
0
|
|
|
|
|
unless (defined $mediumiters[$countcase]{$_}) |
395
|
|
|
|
|
|
|
{ |
396
|
|
|
|
|
|
|
#say "dump (\$mediumiters[\$countcase][\$countblock]{\$_}): " . dump ($mediumiters[$countcase][$countblock]{$_}); |
397
|
0
|
|
|
|
|
|
$mediumiters[$countcase]{$_} = ( round($varinumbers[$countcase]{$_}/2) ); |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
0
|
|
|
|
|
|
$countcase++; |
401
|
|
|
|
|
|
|
} # TO BE CALLED WITH: calcmediumiters(@varinumbers) |
402
|
0
|
|
|
|
|
|
return (@mediumiters); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub getitersnum |
406
|
|
|
|
|
|
|
{ # IT GETS THE NUMBER OF ITERATION. UNUSED. CUT |
407
|
0
|
|
|
0
|
0
|
|
my $countcase = shift; |
408
|
0
|
|
|
|
|
|
my $varinumber = shift; |
409
|
0
|
|
|
|
|
|
my @varinumbers = @_; |
410
|
0
|
|
|
|
|
|
my $itersnum = $varinumbers[$countcase]{$varinumber}; |
411
|
|
|
|
|
|
|
#say "\$itersnum IN = $itersnum"; |
412
|
0
|
|
|
|
|
|
return $itersnum; |
413
|
|
|
|
|
|
|
# IT HAS TO BE CALLED WITH getitersnum($countcase, $varinumber, @varinumbers); |
414
|
|
|
|
|
|
|
} |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub makefilename # IT DEFINES A FILE NAME GIVEN A %carrier. |
417
|
|
|
|
|
|
|
{ |
418
|
0
|
|
|
0
|
0
|
|
my %carrier = @_; |
419
|
0
|
|
|
|
|
|
my $filename = "$mypath/$file" . "_"; |
420
|
0
|
|
|
|
|
|
my $countcase = 0; |
421
|
0
|
|
|
|
|
|
foreach $key (sort {$a <=> $b} (keys %carrier) ) |
|
0
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
{ |
423
|
0
|
|
|
|
|
|
$filename = $filename . $key . "-" . $carrier{$key} . "_"; #say "filename: $filename"; |
424
|
|
|
|
|
|
|
} |
425
|
0
|
|
|
|
|
|
return ($filename); # IT HAS TO BE CALLED WITH: makefilename(%carrier); |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
sub getblocks |
429
|
|
|
|
|
|
|
{ # IT GETS @blocks. TO BE CALLED WITH getblocks(\@sweeps, $countcase) |
430
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
431
|
0
|
|
|
|
|
|
my @sweeps = @$swap; |
432
|
0
|
|
|
|
|
|
my $countcase = shift; |
433
|
0
|
|
|
|
|
|
my @blocks = @{ $sweeps[$countcase]}; |
|
0
|
|
|
|
|
|
|
434
|
0
|
|
|
|
|
|
return (@blocks); |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
#@blocks = getblocks(\@sweeps, 0); say "dumpA( \@blocks) " . dump(@blocks); |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub getblockelts |
440
|
|
|
|
|
|
|
{ # IT GETS @blockelts. TO BE CALLED WITH getblockelts(\@sweeps, $countcase, $countblock) |
441
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
442
|
0
|
|
|
|
|
|
my @sweeps = @$swap; |
443
|
0
|
|
|
|
|
|
my $countcase = shift; |
444
|
0
|
|
|
|
|
|
my $countblock = shift; |
445
|
0
|
|
|
|
|
|
my @blockelts = sort { $a <=> $b } @{ $sweeps[$countcase][$countblock] }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
446
|
0
|
|
|
|
|
|
return (@blockelts); |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub getrootname |
450
|
|
|
|
|
|
|
{ |
451
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
452
|
0
|
|
|
|
|
|
my @rootnames = @$swap; |
453
|
0
|
|
|
|
|
|
my $countcase = shift; |
454
|
0
|
|
|
|
|
|
my $rootname = $rootnames[$countcase]; |
455
|
0
|
|
|
|
|
|
return ($rootname); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
sub extractcase # IT EXTRACTS THE ITEMS TO BE CHANCED FROM A %carrier, UPDATES THE FILE NAME AND CREATES THE NEW ITEM'S CARRIER |
459
|
|
|
|
|
|
|
{ |
460
|
0
|
|
|
0
|
0
|
|
my $file = shift; #say "file: $file"; |
461
|
0
|
|
|
|
|
|
my $carrierref = shift; #say "\$carrierref: " . dump($carrierref); |
462
|
0
|
|
|
|
|
|
my @carrierarray = %$carrierref; #say "\@carrierarray: " . dump(@carrierarray); |
463
|
0
|
|
|
|
|
|
my %carrier = %$carrierref; #say "\%carrier: " . dump(%carrier); |
464
|
0
|
|
|
|
|
|
my $num = ( scalar(@carrierarray) / 2 ); #say "\$num: $num"; |
465
|
0
|
|
|
|
|
|
my $transfile = $file; |
466
|
0
|
|
|
|
|
|
$transfile = "_" . "$transfile"; |
467
|
0
|
|
|
|
|
|
my $counter = 0; |
468
|
0
|
|
|
|
|
|
my %provhash; |
469
|
0
|
|
|
|
|
|
while ($counter < $num) |
470
|
|
|
|
|
|
|
{ #say "\$counter: $counter"; |
471
|
0
|
|
|
|
|
|
$transfile =~ /_(\d+)-(\d+)_/; #say "\$1: $1, \$2: $2"; #say "\$transfileBEFORE: $transfile"; |
472
|
0
|
0
|
0
|
|
|
|
if ( ($1) and ($2) ) |
473
|
|
|
|
|
|
|
{ |
474
|
0
|
|
|
|
|
|
$provhash{$1} = "$2"; |
475
|
|
|
|
|
|
|
} |
476
|
0
|
|
|
|
|
|
$transfile =~ s/$1-$2//; #say "\$transfileAFTER: $transfile"; |
477
|
0
|
|
|
|
|
|
$counter++; |
478
|
|
|
|
|
|
|
} #say "provhash: " . dump(%provhash); |
479
|
0
|
|
|
|
|
|
foreach my $key (keys %provhash) |
480
|
|
|
|
|
|
|
{ |
481
|
0
|
|
|
|
|
|
$carrier{$key} = $provhash{$key}; #say "carrier: " . dump(%carrier); |
482
|
|
|
|
|
|
|
} |
483
|
0
|
|
|
|
|
|
my $to = makefilename(%carrier); # say "\$to: $to"; say "carrier: " . dump(%carrier); |
484
|
0
|
|
|
|
|
|
return($to, \%carrier); # IT HAS TO BE CALLED WITH: extractcase("$string", \%carrier), WHERE STRING IS A PIECE OF FILENAME WITH PARAMETERS. |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub definerootcases #### DEFINES THE ROOT-CASE'S NAME. |
488
|
|
|
|
|
|
|
{ |
489
|
0
|
|
|
0
|
0
|
|
my @sweeps = @{ $_[0] }; #say "dump( \@sweeps) PRE: " . dump(@sweeps); |
|
0
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
|
my @miditers = @{ $_[1] }; #say "dump( \@miditers) PRE: " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
|
my @rootnames; |
492
|
0
|
|
|
|
|
|
my $countcase = 0; |
493
|
0
|
|
|
|
|
|
foreach my $sweep (@sweeps) |
494
|
|
|
|
|
|
|
{ |
495
|
0
|
|
|
|
|
|
my $case = $miditers[$countcase]; |
496
|
0
|
|
|
|
|
|
my %casetopass; |
497
|
|
|
|
|
|
|
my $rootname; |
498
|
0
|
|
|
|
|
|
foreach $key (sort {$a <=> $b} (keys %$case) ) |
|
0
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
{ |
500
|
0
|
|
|
|
|
|
$casetopass{$key} = $miditers[$countcase]{$key}; |
501
|
|
|
|
|
|
|
} |
502
|
0
|
|
|
|
|
|
foreach $key (sort {$a <=> $b} (keys %$case) ) |
|
0
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
{ |
504
|
0
|
|
|
|
|
|
$rootname = $rootname . $key . "-" . $miditers[$countcase]{$key} . "_"; |
505
|
|
|
|
|
|
|
} |
506
|
0
|
|
|
|
|
|
$rootname = "$file" . "_" . "$rootname"; |
507
|
0
|
|
|
|
|
|
$casetopass{rootname} = $rootname; |
508
|
0
|
|
|
|
|
|
chomp $rootname; |
509
|
0
|
|
|
|
|
|
push ( @rootnames, $rootname); |
510
|
0
|
|
|
|
|
|
$countcase++; |
511
|
|
|
|
|
|
|
} |
512
|
0
|
|
|
|
|
|
return (@rootnames); # IT HAS TO BE CALLED WITH: definerootcase(@mediumiters). |
513
|
|
|
|
|
|
|
} |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
sub populatewinners |
516
|
|
|
|
|
|
|
{ |
517
|
0
|
|
|
0
|
0
|
|
my @rootnames = @{ $_[0] }; |
|
0
|
|
|
|
|
|
|
518
|
0
|
|
|
|
|
|
my $countcase = $_[1]; |
519
|
0
|
|
|
|
|
|
my $countblock = $_[2]; |
520
|
0
|
|
|
|
|
|
foreach $case (@rootnames) |
521
|
|
|
|
|
|
|
{ |
522
|
0
|
|
|
|
|
|
push ( @{ $winneritems[$countcase][$countblock] }, $case ); |
|
0
|
|
|
|
|
|
|
523
|
0
|
|
|
|
|
|
$countcase++; |
524
|
|
|
|
|
|
|
} |
525
|
0
|
|
|
|
|
|
return(@winneritems); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub getitem |
529
|
|
|
|
|
|
|
{ # IT GETS THE WINNER OR LOSER LINE. To be called with getitems(\@winner_or_loser_lines, $countcase, $countblock) |
530
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
531
|
0
|
|
|
|
|
|
my @items = @$swap; |
532
|
0
|
|
|
|
|
|
my $countcase = shift; |
533
|
0
|
|
|
|
|
|
my $countblock = shift; |
534
|
0
|
|
|
|
|
|
my $item = $items[$countcase][$countblock]; |
535
|
0
|
|
|
|
|
|
my @arr = @$item; |
536
|
0
|
|
|
|
|
|
my $elt = $arr[0]; |
537
|
0
|
|
|
|
|
|
return ($elt); |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
sub getline |
541
|
|
|
|
|
|
|
{ |
542
|
0
|
|
|
0
|
0
|
|
my $item = shift; |
543
|
0
|
|
|
|
|
|
my $file = "$mypath/" . "$item"; |
544
|
0
|
|
|
|
|
|
return ($file); |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub getlines |
548
|
|
|
|
|
|
|
{ |
549
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
550
|
0
|
|
|
|
|
|
my @items = @$swap; |
551
|
0
|
|
|
|
|
|
my @arr; |
552
|
0
|
|
|
|
|
|
my $countcase = 0; |
553
|
0
|
|
|
|
|
|
foreach (@items) |
554
|
|
|
|
|
|
|
{ |
555
|
0
|
|
|
|
|
|
foreach ( @{ $_ } ) |
|
0
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
{ |
557
|
0
|
|
|
|
|
|
push ( @{ $arr[$countcase] } , getline($_) ); |
|
0
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
} |
559
|
0
|
|
|
|
|
|
$countcase++; |
560
|
|
|
|
|
|
|
} |
561
|
0
|
|
|
|
|
|
return (@arr); |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
sub getcase |
566
|
|
|
|
|
|
|
{ |
567
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
568
|
0
|
|
|
|
|
|
my @items = @$swap; |
569
|
0
|
|
|
|
|
|
my $countcase = shift; |
570
|
0
|
|
|
|
|
|
my $itemref = $items[$countcase]; |
571
|
0
|
|
|
|
|
|
my %item = %{ $itemref }; |
|
0
|
|
|
|
|
|
|
572
|
0
|
|
|
|
|
|
return ( %item ); |
573
|
|
|
|
|
|
|
} |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
sub getstepsvar |
576
|
|
|
|
|
|
|
{ # IT EXTRACTS $stepsvar |
577
|
0
|
|
|
0
|
0
|
|
my $countvar = shift; |
578
|
0
|
|
|
|
|
|
my $countcase = shift; |
579
|
0
|
|
|
|
|
|
my $swap = shift; |
580
|
0
|
|
|
|
|
|
my @varinumbers = @$swap; |
581
|
0
|
|
|
|
|
|
my $varnumsref = $varinumbers[ $countcase ]; |
582
|
0
|
|
|
|
|
|
my %varnums = %{ $varnumsref }; |
|
0
|
|
|
|
|
|
|
583
|
0
|
|
|
|
|
|
my $stepsvar = $varnums{$countvar}; |
584
|
0
|
|
|
|
|
|
return ($stepsvar) |
585
|
|
|
|
|
|
|
} #getstepsvar($countvar, $countcase, \@varinumbers); |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
sub givesize |
588
|
|
|
|
|
|
|
{ # IT RETURNS THE SEARCH SIZE OF A BLOCK. |
589
|
0
|
|
|
0
|
0
|
|
my $sliceref = shift; |
590
|
0
|
|
|
|
|
|
my @slice = @$sliceref; |
591
|
0
|
|
|
|
|
|
my $countcase = shift; |
592
|
0
|
|
|
|
|
|
my $varinumberref = shift; |
593
|
0
|
|
|
|
|
|
my $product = 1; |
594
|
0
|
|
|
|
|
|
foreach my $elt (@slice) |
595
|
|
|
|
|
|
|
{ |
596
|
0
|
|
|
|
|
|
my $stepsize = Sim::OPT::getstepsvar($elt, $countcase, $varinumberref); |
597
|
0
|
|
|
|
|
|
$product = $product * $stepsize; |
598
|
|
|
|
|
|
|
} |
599
|
0
|
|
|
|
|
|
return ($product); # TO BE CALLED WITH: givesize(\@slice, $countcase, \@varinumbers);, WHERE SLICE MAY BE @blockelts in SIM::OPT OR @presentslice OR @pastslice IN Sim::OPT::Takechance |
600
|
|
|
|
|
|
|
} |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
sub wash # UNUSED. CUT. |
603
|
|
|
|
|
|
|
{ |
604
|
0
|
|
|
0
|
0
|
|
my @instances = @_; |
605
|
0
|
|
|
|
|
|
my @bag; |
606
|
|
|
|
|
|
|
my @rightbag; |
607
|
0
|
|
|
|
|
|
foreach my $instanceref (@instances) |
608
|
|
|
|
|
|
|
{ |
609
|
0
|
|
|
|
|
|
my %d = %{ $instanceref }; |
|
0
|
|
|
|
|
|
|
610
|
0
|
|
|
|
|
|
my $to = $d{to}; |
611
|
0
|
|
|
|
|
|
push (@bag, $to); |
612
|
|
|
|
|
|
|
} |
613
|
0
|
|
|
|
|
|
my $count = 0; |
614
|
0
|
|
|
|
|
|
foreach my $instanceref (@instances) |
615
|
|
|
|
|
|
|
{ |
616
|
0
|
|
|
|
|
|
my %d = %{ $instanceref }; |
|
0
|
|
|
|
|
|
|
617
|
0
|
|
|
|
|
|
my $to = $d{to}; |
618
|
0
|
0
|
|
|
|
|
if ( not ( $to ~~ @bag ) ) |
619
|
|
|
|
|
|
|
{ |
620
|
0
|
|
|
|
|
|
push ( @rightbag, \%d ); |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
} |
623
|
0
|
|
|
|
|
|
return (@rightbag); # TO BE CALLED WITH wash(@instances); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
sub flattenbox |
627
|
|
|
|
|
|
|
{ |
628
|
0
|
|
|
0
|
0
|
|
my @basket; |
629
|
0
|
|
|
|
|
|
foreach my $eltsref (@_) |
630
|
|
|
|
|
|
|
{ |
631
|
0
|
|
|
|
|
|
my @elts = @$eltsref; |
632
|
0
|
|
|
|
|
|
push (@basket, @elts); |
633
|
|
|
|
|
|
|
} |
634
|
0
|
|
|
|
|
|
return(@basket); |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub integratebox |
639
|
|
|
|
|
|
|
{ |
640
|
0
|
|
|
0
|
0
|
|
my @arrelts = @{ $_[0] }; #say "\@arrelts " . dump(@arrelts); |
|
0
|
|
|
|
|
|
|
641
|
0
|
|
|
|
|
|
my %carrier = %{ $_[1] }; #say "\%carrier " . dump(%carrier); |
|
0
|
|
|
|
|
|
|
642
|
0
|
|
|
|
|
|
my $file = $_[2]; #say "\$file " . dump($file); |
643
|
0
|
|
|
|
|
|
my @newbox; |
644
|
0
|
|
|
|
|
|
foreach my $eltref ( @arrelts ) |
645
|
|
|
|
|
|
|
{ |
646
|
0
|
|
|
|
|
|
my @elts = @{ $eltref }; #say "\@elts " . dump(@elts); |
|
0
|
|
|
|
|
|
|
647
|
0
|
|
|
|
|
|
my $target = $elts[0]; #say "\$target " . dump($target); |
648
|
0
|
|
|
|
|
|
my $origin = $elts[3]; #say "\$origin " . dump($origin); |
649
|
0
|
|
|
|
|
|
my @result = extractcase( $target, \%carrier ); say "\@result: " . dump(@result); |
|
0
|
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
my $righttarget = $result[0]; |
651
|
0
|
|
|
|
|
|
my @result = extractcase( $origin, \%carrier ); |
652
|
0
|
|
|
|
|
|
my $rightorigin = $result[0]; |
653
|
0
|
|
|
|
|
|
push (@newbox, [ $righttarget, $elts[1], $elts[2], $rightorigin ] ); |
654
|
|
|
|
|
|
|
} |
655
|
0
|
|
|
|
|
|
return (@newbox); # TO BE CALLED WITH: integratebox(\@flattened, \%mids), $file); # %mids is %carrier. $file is the blank root folder. |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
sub filterbox |
660
|
|
|
|
|
|
|
{ |
661
|
0
|
|
|
0
|
0
|
|
@arr = @_; |
662
|
0
|
|
|
|
|
|
my @basket; |
663
|
|
|
|
|
|
|
my @box; |
664
|
0
|
|
|
|
|
|
foreach my $case (@arr) |
665
|
|
|
|
|
|
|
{ |
666
|
0
|
|
|
|
|
|
my $elt = $case->[0]; |
667
|
0
|
0
|
|
|
|
|
if ( not ( $elt ~~ @box ) ) |
668
|
|
|
|
|
|
|
{ |
669
|
0
|
|
|
|
|
|
my @bucket; |
670
|
0
|
|
|
|
|
|
foreach $caseagain (@arr) |
671
|
|
|
|
|
|
|
{ |
672
|
0
|
|
|
|
|
|
my $el = $caseagain->[0]; |
673
|
0
|
0
|
|
|
|
|
if ( $elt ~~ $el ) |
674
|
|
|
|
|
|
|
{ |
675
|
0
|
|
|
|
|
|
push ( @bucket, $case ); |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
} |
678
|
0
|
|
|
|
|
|
my $parent = $bucket[0]; |
679
|
0
|
|
|
|
|
|
push (@basket, $parent); |
680
|
0
|
|
|
|
|
|
foreach (@basket) |
681
|
|
|
|
|
|
|
{ |
682
|
0
|
|
|
|
|
|
push (@box, $_->[0]); |
683
|
|
|
|
|
|
|
} |
684
|
|
|
|
|
|
|
} |
685
|
|
|
|
|
|
|
} |
686
|
0
|
|
|
|
|
|
return (@basket); |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub callcase # IT PROCESSES THE CASES. |
690
|
|
|
|
|
|
|
{ |
691
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
692
|
0
|
|
|
|
|
|
my %dat = %{$swap}; |
|
0
|
|
|
|
|
|
|
693
|
0
|
|
|
|
|
|
my $countcase = $dat{countcase}; #say "dump(\$countcase): " . dump($countcase); |
694
|
0
|
|
|
|
|
|
my $countblock = $dat{countblock}; #say "dump(\$countblock): " . dump($countblock); |
695
|
0
|
|
|
|
|
|
my @miditers = @{ $dat{miditers} }; #say "dump(\@miditers): " . dump(@miditers); # IT BECOMES THE CARRIER. INITIALIZED AT FIRST BLOCKS; INHERITED AFTER. |
|
0
|
|
|
|
|
|
|
696
|
0
|
|
|
|
|
|
my @winneritems = @{ $dat{winneritems} }; #say "dumpIN( \@winneritems) " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
697
|
0
|
|
|
|
|
|
my %dirfiles = %{ $dat{dirfiles} }; #say "dumpIN( \%dirfiles) " . dump(%dirfiles); |
|
0
|
|
|
|
|
|
|
698
|
0
|
|
|
|
|
|
my @uplift = @{ $dat{uplift} }; #say "dumpIN( \@uplift) " . dump(@uplift); |
|
0
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
#eval($getparshere); |
700
|
|
|
|
|
|
|
|
701
|
0
|
|
|
|
|
|
my $rootname = getrootname(\@rootnames, $countcase); #say "dump(\$rootname): " . dump($rootname); |
702
|
0
|
|
|
|
|
|
my @blockelts = getblockelts(\@sweeps, $countcase, $countblock); #say "dumpIN( \@blockelts) " . dump(@blockelts); |
703
|
0
|
|
|
|
|
|
my @blocks = getblocks(\@sweeps, $countcase); #say "dumpIN( \@blocks) " . dump(@blocks); |
704
|
0
|
|
|
|
|
|
my $toitem = getitem(\@winneritems, $countcase, $countblock); #say "dump(\$toitem): " . dump($toitem); |
705
|
0
|
|
|
|
|
|
my $from = getline($toitem); #say "dump(\$from): " . dump($from); |
706
|
|
|
|
|
|
|
#my @winnerlines = getlines( \@winneritems ); say "dump(\@winnerlines): " . dump(@winnerlines); |
707
|
0
|
|
|
|
|
|
my %varnums = getcase(\@varinumbers, $countcase); #say "dumpININ---(\%varnums): " . dump(%varnums); |
708
|
0
|
|
|
|
|
|
my %mids = getcase(\@miditers, $countcase); #say "dumpININ---(\%mids): " . dump(%mids); |
709
|
|
|
|
|
|
|
#eval($getfly); |
710
|
|
|
|
|
|
|
|
711
|
0
|
0
|
|
|
|
|
if ($countblock == 0 ) { my %dirfiles; } |
|
0
|
|
|
|
|
|
|
712
|
0
|
|
|
|
|
|
$dirfiles{simlist} = "$mypath/$file-simlist--$countcase"; |
713
|
0
|
|
|
|
|
|
$dirfiles{morphlist} = "$mypath/$file-morphlist--$countcase"; |
714
|
0
|
|
|
|
|
|
$dirfiles{retlist} = "$mypath/$file-retlist--$countcase"; |
715
|
0
|
|
|
|
|
|
$dirfiles{replist} = "$mypath/$file-replist--$countcase"; # # FOR RETRIEVAL |
716
|
0
|
|
|
|
|
|
$dirfiles{descendlist} = "$mypath/$file-descendlist--$countcase"; # UNUSED FOR NOW |
717
|
0
|
|
|
|
|
|
$dirfiles{simblock} = "$mypath/$file-simblock--$countcase-$countblock"; |
718
|
0
|
|
|
|
|
|
$dirfiles{morphblock} = "$mypath/$file-morphblock--$countcase-$countblock"; |
719
|
0
|
|
|
|
|
|
$dirfiles{retblock} = "$mypath/$file-retblock--$countcase-$countblock"; |
720
|
0
|
|
|
|
|
|
$dirfiles{repblock} = "$mypath/$file-repblock--$countcase-$countblock"; # # FOR RETRIEVAL |
721
|
0
|
|
|
|
|
|
$dirfiles{descendblock} = "$mypath/$file-descendblock--$countcase-$countblock"; # UNUSED FOR NOW |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
#if ($countblock == 0 ) |
724
|
|
|
|
|
|
|
#{ |
725
|
|
|
|
|
|
|
# ( $dirfiles{morphcases}, $dirfiles{morphstruct}, $dirfiles{simcases}, $dirfiles{simstruct}, $dirfiles{retcases}, |
726
|
|
|
|
|
|
|
# $dirfiles{retstruct}, $dirfiles{repcases}, $dirfiles{repstruct}, $dirfiles{mergecases}, $dirfiles{mergestruct}, |
727
|
|
|
|
|
|
|
# $dirfiles{descendcases}, $dirfiles{descendstruct} ); |
728
|
|
|
|
|
|
|
#} |
729
|
|
|
|
|
|
|
|
730
|
0
|
0
|
|
|
|
|
open ( OUTFILE, ">>$outfile" ) or die "Can't open $outfile: $!"; |
731
|
0
|
0
|
|
|
|
|
open ( TOSHELL, ">>$toshell" ) or die "Can't open $toshell: $!"; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
#if ( ($countcase > 0) or ($countblock > 0) ) |
734
|
|
|
|
|
|
|
#{ |
735
|
0
|
|
|
|
|
|
say $tee "#Called for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
736
|
|
|
|
|
|
|
#} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
#my @taken = extractcase("$toitem", \%mids); #say "------->taken: " . dump(@taken); |
739
|
|
|
|
|
|
|
#my $to = $taken[0]; #say "to-------->: $to"; |
740
|
|
|
|
|
|
|
#my %carrier = %{$taken[1]}; #say "\%instancecarrier:--------->" . dump(%instancecarrier); |
741
|
|
|
|
|
|
|
#say $tee "#Calling a new block for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
742
|
0
|
|
|
|
|
|
my $casedata = { |
743
|
|
|
|
|
|
|
countcase => $countcase, countblock => $countblock, |
744
|
|
|
|
|
|
|
miditers => \@miditers, winneritems => \@winneritems, |
745
|
|
|
|
|
|
|
dirfiles => \%dirfiles, uplift => \@uplift |
746
|
|
|
|
|
|
|
}; #say $tee "#\n\dumpCASE(\$casedata): " . dump($casedata) . "\n\n"; |
747
|
|
|
|
|
|
|
#say $tee "IN OPT.pm, \$casedata: " . dump($casedata); |
748
|
0
|
|
|
|
|
|
callblocks( $casedata ); |
749
|
0
|
0
|
|
|
|
|
if ( $countblock != 0 ) { return($casedata); } |
|
0
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub callblocks # IT CALLS THE SEARCH ON BLOCKS. |
753
|
|
|
|
|
|
|
{ |
754
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
755
|
0
|
|
|
|
|
|
my %dat = %{$swap}; |
|
0
|
|
|
|
|
|
|
756
|
0
|
|
|
|
|
|
my $countcase = $dat{countcase}; #say $tee "dump(\$countcase): " . dump($countcase); |
757
|
0
|
|
|
|
|
|
my $countblock = $dat{countblock}; #say $tee "dump(\$countblock): " . dump($countblock); |
758
|
0
|
|
|
|
|
|
my @miditers = @{ $dat{miditers} }; #say $tee "dump(\@miditers): " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
759
|
0
|
|
|
|
|
|
my @winneritems = @{ $dat{winneritems} }; #say $tee "dumpIN( \@winneritems) " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
760
|
0
|
|
|
|
|
|
my %dirfiles = %{ $dat{dirfiles} }; #say $tee "dumpIN( \%dirfiles) " . dump(%dirfiles); |
|
0
|
|
|
|
|
|
|
761
|
0
|
|
|
|
|
|
my @uplift = @{ $dat{uplift} }; #say $tee "dumpIN( \@uplift) " . dump(@uplift); |
|
0
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
#eval($getparshere); |
763
|
|
|
|
|
|
|
|
764
|
0
|
|
|
|
|
|
my $rootname = getrootname(\@rootnames, $countcase); #say $tee "dump(\$rootname): " . dump($rootname); |
765
|
0
|
|
|
|
|
|
my @blockelts = getblockelts(\@sweeps, $countcase, $countblock); #say $tee "dumpIN( \@blockelts) " . dump(@blockelts); |
766
|
0
|
|
|
|
|
|
my @blocks = getblocks(\@sweeps, $countcase); #say $tee "dumpIN( \@blocks) " . dump(@blocks); |
767
|
0
|
|
|
|
|
|
my $toitem = getitem(\@winneritems, $countcase, $countblock); #say $tee "dump(\$toitem): " . dump($toitem); |
768
|
0
|
|
|
|
|
|
my $from = getline($toitem); #say $tee "dump(\$from): " . dump($from); |
769
|
0
|
|
|
|
|
|
my %varnums = getcase(\@varinumbers, $countcase); #say $tee "dumpININ---(\%varnums): " . dump(%varnums); |
770
|
0
|
|
|
|
|
|
my %mids = getcase(\@miditers, $countcase); #say $tee "dumpININ---(\%mids): " . dump(%mids); |
771
|
|
|
|
|
|
|
#eval($getfly); |
772
|
0
|
|
|
|
|
|
say $tee "#Called for a new block for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
773
|
0
|
|
|
|
|
|
say $tee "#Calling to define new files for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
774
|
0
|
|
|
|
|
|
my $blockdata = |
775
|
|
|
|
|
|
|
{ |
776
|
|
|
|
|
|
|
countcase => $countcase, countblock => $countblock, |
777
|
|
|
|
|
|
|
miditers => \@miditers, winneritems => \@winneritems, |
778
|
|
|
|
|
|
|
dirfiles => \%dirfiles, uplift => \@uplift, |
779
|
|
|
|
|
|
|
}; #say $tee "\ndumpBLOCK(\$blockdata): " . dump($blockdata) . "\n\n"; |
780
|
0
|
|
|
|
|
|
deffiles( $blockdata ); |
781
|
|
|
|
|
|
|
} |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
sub deffiles # IT DEFINED THE FILES TO BE CALLED. |
784
|
|
|
|
|
|
|
{ |
785
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
786
|
0
|
|
|
|
|
|
my %dat = %{$swap}; |
|
0
|
|
|
|
|
|
|
787
|
0
|
|
|
|
|
|
my $countcase = $dat{countcase}; #say $tee "#dump(\$countcase): " . dump($countcase); |
788
|
0
|
|
|
|
|
|
my $countblock = $dat{countblock}; #say $tee "#dump(\$countblock): " . dump($countblock); |
789
|
0
|
|
|
|
|
|
my @miditers = @{ $dat{miditers} }; #say $tee "#dump(\@miditers): " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
790
|
0
|
|
|
|
|
|
my @winneritems = @{ $dat{winneritems} }; #say $tee "#dumpIN( \@winneritems) " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
791
|
0
|
|
|
|
|
|
my %dirfiles = %{ $dat{dirfiles} }; #say $tee "#dumpIN( \%dirfiles) " . dump(%dirfiles); |
|
0
|
|
|
|
|
|
|
792
|
0
|
|
|
|
|
|
my @uplift = @{ $dat{uplift} }; #say $tee "#dumpIN( \@uplift) " . dump(@uplift); |
|
0
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
#eval($getparshere); |
794
|
|
|
|
|
|
|
|
795
|
0
|
|
|
|
|
|
my $rootname = getrootname(\@rootnames, $countcase); #say $tee "#dump(\$rootname): " . dump($rootname); |
796
|
0
|
|
|
|
|
|
my @blockelts = getblockelts(\@sweeps, $countcase, $countblock); #say $tee "#dumpIN( \@blockelts) " . dump(@blockelts); |
797
|
0
|
|
|
|
|
|
my @blocks = getblocks(\@sweeps, $countcase); #say $tee "#dumpIN( \@blocks) " . dump(@blocks); |
798
|
0
|
|
|
|
|
|
my $toitem = getitem(\@winneritems, $countcase, $countblock); #say $tee "#dump(\$toitem): " . dump($toitem); |
799
|
0
|
|
|
|
|
|
my $from = getline($toitem); #say $tee "#dump(\$from): " . dump($from); |
800
|
0
|
|
|
|
|
|
my %varnums = getcase(\@varinumbers, $countcase); #say $tee "#dumpININ---(\%varnums): " . dump(%varnums); |
801
|
0
|
|
|
|
|
|
my %mids = getcase(\@miditers, $countcase); #say $tee "#dumpININ---(\%mids): " . dump(%mids); |
802
|
|
|
|
|
|
|
#eval($getfly); |
803
|
|
|
|
|
|
|
|
804
|
0
|
|
|
|
|
|
say $tee "#Called to define new files for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
805
|
|
|
|
|
|
|
|
806
|
0
|
|
|
|
|
|
my $rootitem = "$file" . "_"; #say "\$rootitem $rootitem"; |
807
|
0
|
|
|
|
|
|
my (@basket, @box); |
808
|
0
|
|
|
|
|
|
push (@basket, [ $rootitem ] ); |
809
|
0
|
|
|
|
|
|
foreach my $var ( @blockelts ) |
810
|
|
|
|
|
|
|
{ |
811
|
0
|
|
|
|
|
|
my @bucket; |
812
|
0
|
|
|
|
|
|
my $maxvalue = $varnums{$var}; #say $tee "#\$countblock $countblock, var: $var, maxvalue: $maxvalue"; |
813
|
0
|
|
|
|
|
|
foreach my $elt (@basket) |
814
|
|
|
|
|
|
|
{ |
815
|
0
|
|
|
|
|
|
my $root = $elt->[0]; #say $tee "#\$root " . dump($root); |
816
|
0
|
|
|
|
|
|
my $cnstep = 1; |
817
|
0
|
|
|
|
|
|
while ( $cnstep <= $maxvalue) |
818
|
|
|
|
|
|
|
{ |
819
|
0
|
|
|
|
|
|
my $olditem = $root; |
820
|
0
|
|
|
|
|
|
my $item = "$root" . "$var" . "-" . "$cnstep" . "_" ; #say $tee "#\$item making: $item, \$root: $root, \$var: $var, \$cnstep: $cnstep, \$root: $root "; |
821
|
0
|
|
|
|
|
|
push (@bucket, [$item, $var, $cnstep, $olditem] ); #say $tee "#\@bucketIN " . dump(@bucket); |
822
|
0
|
|
|
|
|
|
$cnstep++; |
823
|
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
|
} |
825
|
0
|
|
|
|
|
|
@basket = (); |
826
|
0
|
|
|
|
|
|
@basket = @bucket; |
827
|
0
|
|
|
|
|
|
push ( @box, [ @bucket ] ); |
828
|
|
|
|
|
|
|
#say $tee "#\@box INOUT" . dump(@box); |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
#say $tee "#\@box!: " . dump ( @box ); |
831
|
|
|
|
|
|
|
|
832
|
0
|
|
|
|
|
|
my @flattened = flattenbox(@box); #say $tee "#\@flattened: " . dump(@flattened) . ", " . scalar(@flattened); |
833
|
0
|
|
|
|
|
|
my @integrated = integratebox(\@flattened, \%mids, $file); #say $tee "#\@integrated " . dump(@integrated) . ", " . scalar(@integrated); |
834
|
0
|
|
|
|
|
|
my @finalbox = filterbox(@integrated); #say $tee "#\@finalbox " . dump(@finalbox) . ", " . scalar(@finalbox); |
835
|
|
|
|
|
|
|
|
836
|
0
|
|
|
|
|
|
say $tee "#Calling to instruct the launch of new searches for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
837
|
0
|
|
|
|
|
|
my $datatowork = |
838
|
|
|
|
|
|
|
{ |
839
|
|
|
|
|
|
|
countcase => $countcase, countblock => $countblock, |
840
|
|
|
|
|
|
|
miditers => \@miditers, winneritems => \@winneritems, |
841
|
|
|
|
|
|
|
dirfiles => \%dirfiles, uplift => \@uplift, |
842
|
|
|
|
|
|
|
basket => \@finalbox |
843
|
|
|
|
|
|
|
} ; |
844
|
|
|
|
|
|
|
# say $tee "\ndumper-datatowork: " . dump($datatowork) . "\n\n"; |
845
|
0
|
|
|
|
|
|
setlaunch( $datatowork ); |
846
|
|
|
|
|
|
|
} |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
sub setlaunch # IT SETS THE DATA FOR THE SEARCH ON THE ACTIVE BLOCK. |
849
|
|
|
|
|
|
|
{ |
850
|
0
|
|
|
0
|
0
|
|
my $swap = shift; |
851
|
0
|
|
|
|
|
|
my %dat = %{$swap}; |
|
0
|
|
|
|
|
|
|
852
|
0
|
|
|
|
|
|
my $countcase = $dat{countcase}; #say "dump(\$countcase): " . dump($countcase); |
853
|
0
|
|
|
|
|
|
my $countblock = $dat{countblock}; #say "dump(\$countblock): " . dump($countblock); |
854
|
0
|
|
|
|
|
|
my @miditers = @{ $dat{miditers} }; #say "dump(\@miditers): " . dump(@miditers); |
|
0
|
|
|
|
|
|
|
855
|
0
|
|
|
|
|
|
my @winneritems = @{ $dat{winneritems} }; #say "dumpIN( \@winneritems) " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
856
|
0
|
|
|
|
|
|
my %dirfiles = %{ $dat{dirfiles} }; #say "dumpIN( \%dirfiles) " . dump(%dirfiles); |
|
0
|
|
|
|
|
|
|
857
|
0
|
|
|
|
|
|
my @uplift = @{ $dat{uplift} }; #say "dumpIN( \@uplift) " . dump(@uplift); |
|
0
|
|
|
|
|
|
|
858
|
0
|
|
|
|
|
|
my @basket = @{ $dat{basket} }; #say "dumpIN( \@basket) " . dump(@basket); |
|
0
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
#eval($getparshere); |
860
|
|
|
|
|
|
|
|
861
|
0
|
|
|
|
|
|
my $rootname = getrootname(\@rootnames, $countcase); #say "dump(\$rootname): " . dump($rootname); |
862
|
0
|
|
|
|
|
|
my @blockelts = getblockelts(\@sweeps, $countcase, $countblock); #say "dumpIN( \@blockelts) " . dump(@blockelts); |
863
|
0
|
|
|
|
|
|
my @blocks = getblocks(\@sweeps, $countcase); #say "dumpIN( \@blocks) " . dump(@blocks); |
864
|
0
|
|
|
|
|
|
my $toitem = getitem(\@winneritems, $countcase, $countblock); #say "dump(\$toitem): " . dump($toitem); |
865
|
0
|
|
|
|
|
|
my $from = getline($toitem); #say "dump(\$from): " . dump($from); |
866
|
0
|
|
|
|
|
|
my %varnums = getcase(\@varinumbers, $countcase); #say "dumpININ---(\%varnums): " . dump(%varnums); |
867
|
0
|
|
|
|
|
|
my %mids = getcase(\@miditers, $countcase); #say "dumpININ---(\%mids): " . dump(%mids); |
868
|
|
|
|
|
|
|
#eval($getfly); |
869
|
|
|
|
|
|
|
|
870
|
0
|
|
|
|
|
|
say $tee "#Called to instruct the launch of new searches for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
871
|
|
|
|
|
|
|
|
872
|
0
|
|
|
|
|
|
my ( @instances, %carrier); |
873
|
|
|
|
|
|
|
#if ($countblock == 0) |
874
|
|
|
|
|
|
|
#{ |
875
|
|
|
|
|
|
|
# %carrier = %mids; #say "\%carrier! STARTING:--->" . dump(%carrier); |
876
|
|
|
|
|
|
|
#} |
877
|
|
|
|
|
|
|
#else |
878
|
|
|
|
|
|
|
#{ |
879
|
|
|
|
|
|
|
# my $prov = "_" . "$winnerline"; |
880
|
|
|
|
|
|
|
# %carrier = extractcase( $prov , \%carrier ); #say "\%carrier! EXTRACTED:--->" . dump(%carrier); |
881
|
|
|
|
|
|
|
#} |
882
|
|
|
|
|
|
|
|
883
|
0
|
|
|
|
|
|
foreach my $elt ( @basket ) |
884
|
|
|
|
|
|
|
{ |
885
|
|
|
|
|
|
|
|
886
|
0
|
|
|
|
|
|
my $newpars = $$elt[0]; #say "\$newpars : $newpars"; |
887
|
0
|
|
|
|
|
|
my $countvar = $$elt[1]; #say "\$countvar : $countvar"; |
888
|
0
|
|
|
|
|
|
my $countstep = $$elt[2]; #say "\$countstep : $countstep"; |
889
|
0
|
|
|
|
|
|
my $oldpars = $$elt[3]; #say "\$oldpars : $oldpars"; |
890
|
0
|
|
|
|
|
|
my @taken = extractcase("$newpars", \%mids); #say "--->taken: " . dump(@taken); |
891
|
0
|
|
|
|
|
|
my $to = $taken[0]; #say "to--->: $to"; |
892
|
|
|
|
|
|
|
#my %instancecarrier = %{$taken[1]}; #say "\%instancecarrier!:--->" . dump(%instancecarrier); # UNUSED |
893
|
0
|
|
|
|
|
|
my @olds = extractcase("$oldpars", \%mids); #say "--->@olds " . dump(@olds); |
894
|
0
|
|
|
|
|
|
my $origin = $olds[0]; #say "$origin--->: $origin"; |
895
|
0
|
|
|
|
|
|
push (@instances, |
896
|
|
|
|
|
|
|
{ |
897
|
|
|
|
|
|
|
countcase => $countcase, countblock => $countblock, |
898
|
|
|
|
|
|
|
miditers => \@miditers, winneritems => \@winneritems, |
899
|
|
|
|
|
|
|
dirfiles => \%dirfiles, uplift => \@uplift, |
900
|
|
|
|
|
|
|
to => $to, countvar => $countvar, countstep => $countstep, |
901
|
|
|
|
|
|
|
origin => $origin |
902
|
|
|
|
|
|
|
} ); |
903
|
|
|
|
|
|
|
} |
904
|
0
|
|
|
|
|
|
say $tee "#Calling to execute the launch of new searches for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
905
|
|
|
|
|
|
|
|
906
|
0
|
|
|
|
|
|
say $tee "\ninstances: " . dump(@instances). "\n\n"; ### ZZZ |
907
|
0
|
|
|
|
|
|
exe( @instances ); # IT HAS TO BE CALLED WITH: setlaunch(@datatowork). @datatowork ARE CONSTITUTED BY AN ARRAY OF: ( [ \@blocks, \%varnums, \%bases, $name, $countcase, \@blockelts, $countblock ], ... ) |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
sub exe |
911
|
|
|
|
|
|
|
{ |
912
|
0
|
|
|
0
|
0
|
|
my @instances = @_; |
913
|
|
|
|
|
|
|
|
914
|
0
|
|
|
|
|
|
my $firstinst = $instances[0]; |
915
|
0
|
|
|
|
|
|
my %d = %{ $firstinst }; |
|
0
|
|
|
|
|
|
|
916
|
0
|
|
|
|
|
|
my $countcase = $d{countcase}; #say "dump(\$countcase): " . dump($countcase); |
917
|
0
|
|
|
|
|
|
my $countblock = $d{countblock}; #say "dump(\$countblock): " . dump($countblock); |
918
|
0
|
|
|
|
|
|
my %dirfiles = %{ $d{ dirfiles } }; |
|
0
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
|
920
|
0
|
|
|
|
|
|
say $tee "#Called to execute the launch of new searches for case " . ($countcase +1) . ", block " . ($countblock + 1) . "."; |
921
|
|
|
|
|
|
|
#say $tee "Do what:" . dump(%dowhat); |
922
|
|
|
|
|
|
|
|
923
|
0
|
0
|
|
|
|
|
if ( $dowhat{morph} eq "y" ) |
924
|
|
|
|
|
|
|
{ |
925
|
0
|
|
|
|
|
|
say $tee "#Calling morphing operations for case " . ($countcase +1) . "block " . ($countblock + 1) . "."; |
926
|
|
|
|
|
|
|
#say $tee "WITH: \@instances " . dump(@instances) . ", \$countcase $countcase, \$countblock $countblock, \%dirfiles " . dump(%dirfiles) . "."; |
927
|
0
|
|
|
|
|
|
my @result = Sim::OPT::Morph::morph( |
928
|
|
|
|
|
|
|
{ |
929
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
930
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
931
|
|
|
|
|
|
|
} ); |
932
|
0
|
|
|
|
|
|
$dirfiles{morphcases} = $result[0]; |
933
|
0
|
|
|
|
|
|
$dirfiles{morphstruct} = $result[1]; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
|
936
|
0
|
0
|
|
|
|
|
if ( $dowhat{simulate} eq "y" ) |
937
|
|
|
|
|
|
|
{ |
938
|
0
|
|
|
|
|
|
say $tee "#Calling simulations for case " . ($countcase +1) . "block " . ($countblock + 1) . "."; |
939
|
0
|
|
|
|
|
|
my @result = Sim::OPT::Sim::sim( |
940
|
|
|
|
|
|
|
{ |
941
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
942
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
943
|
|
|
|
|
|
|
} ); |
944
|
0
|
|
|
|
|
|
$dirfiles{simcases} = $result[0]; #say $tee "\$dirfiles{simcases} : " . dump( $dirfiles{simcases} ); |
945
|
0
|
|
|
|
|
|
$dirfiles{simstruct} = $result[1]; |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
0
|
0
|
|
|
|
|
if ( $dowhat{retrieve} eq "y" ) |
949
|
|
|
|
|
|
|
{ |
950
|
0
|
|
|
|
|
|
say $tee "#Calling retrieval of results for case " . ($countcase +1) . "block " . ($countblock + 1) . "."; |
951
|
0
|
|
|
|
|
|
my @result = Sim::OPT::Retrieve::retrieve( |
952
|
|
|
|
|
|
|
{ |
953
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
954
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
955
|
|
|
|
|
|
|
} ); |
956
|
0
|
|
|
|
|
|
$dirfiles{retcases} = $result[0]; #say $tee "\$dirfiles{retcases} : " . dump( $dirfiles{retcases} ); |
957
|
0
|
|
|
|
|
|
$dirfiles{retstruct} = $result[1]; |
958
|
|
|
|
|
|
|
} |
959
|
|
|
|
|
|
|
|
960
|
0
|
0
|
|
|
|
|
if ( $dowhat{report} eq "y" ) |
961
|
|
|
|
|
|
|
{ |
962
|
0
|
|
|
|
|
|
say $tee "#Calling the reporting of results for case " . ($countcase +1) . "block " . ($countblock + 1) . "."; |
963
|
0
|
|
|
|
|
|
my @result = Sim::OPT::Report::report( |
964
|
|
|
|
|
|
|
{ |
965
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
966
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
967
|
|
|
|
|
|
|
} ); |
968
|
0
|
|
|
|
|
|
$dirfiles{repcases} = $result[0]; |
969
|
0
|
|
|
|
|
|
$dirfiles{repstruct} = $result[1]; |
970
|
0
|
|
|
|
|
|
$dirfiles{mergestruct} = $result[2]; |
971
|
0
|
|
|
|
|
|
$dirfiles{mergecases} = $result[3]; |
972
|
0
|
|
|
|
|
|
$repfile = $result[4]; |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
|
975
|
0
|
0
|
|
|
|
|
if ( $dowhat{descend} eq "y" ) |
976
|
|
|
|
|
|
|
{ |
977
|
0
|
|
|
|
|
|
say $tee "#Calling the descent in case " . ($countcase +1) . "block " . ($countblock + 1) . "."; |
978
|
0
|
|
|
|
|
|
my @result = Sim::OPT::Descend::descend( |
979
|
|
|
|
|
|
|
{ |
980
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
981
|
|
|
|
|
|
|
dirfiles => \%dirfiles, repfile => $repfile |
982
|
|
|
|
|
|
|
} ); |
983
|
0
|
|
|
|
|
|
$dirfiles{descendcases} = $result[0]; |
984
|
0
|
|
|
|
|
|
$dirfiles{descendstruct} = $result[1]; |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
|
987
|
0
|
0
|
|
|
|
|
if ( $dowhat{substitutenames} eq "y" ) |
988
|
|
|
|
|
|
|
{ |
989
|
0
|
|
|
|
|
|
Sim::OPT::Report::filter_reports( |
990
|
|
|
|
|
|
|
{ |
991
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
992
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
993
|
|
|
|
|
|
|
} ); |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
0
|
0
|
|
|
|
|
if ( $dowhat{filterconverted} eq "y" ) |
997
|
|
|
|
|
|
|
{ |
998
|
0
|
|
|
|
|
|
Sim::OPT::Report::convert_filtered_reports( |
999
|
|
|
|
|
|
|
{ |
1000
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
1001
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
1002
|
|
|
|
|
|
|
} ); |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
|
1005
|
0
|
0
|
|
|
|
|
if ( $dowhat{make3dtable} eq "y" ) |
1006
|
|
|
|
|
|
|
{ |
1007
|
0
|
|
|
|
|
|
Sim::OPT::Report::maketable( |
1008
|
|
|
|
|
|
|
{ |
1009
|
|
|
|
|
|
|
instances => \@instances, countcase => $countcase, countblock => $countblock, |
1010
|
|
|
|
|
|
|
dirfiles => \%dirfiles |
1011
|
|
|
|
|
|
|
} ); |
1012
|
|
|
|
|
|
|
} #say "getexe: " . dump(@instances); |
1013
|
|
|
|
|
|
|
} # END SUB exe |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
sub start |
1016
|
|
|
|
|
|
|
{ |
1017
|
|
|
|
|
|
|
########################################### |
1018
|
0
|
|
|
0
|
0
|
|
print "THIS IS OPT. |
1019
|
|
|
|
|
|
|
Copyright by Gian Luca Brunetti and Politecnico di Milano, 2008-14. |
1020
|
|
|
|
|
|
|
{ DAStU Department, Polytechnic of Milan } |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
. . . . . . . . . . . . . |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
Please insert the name of a configuration file for OPT (Unix path)\n\n"; |
1025
|
|
|
|
|
|
|
########################################### |
1026
|
0
|
|
|
|
|
|
$configfile = ; |
1027
|
0
|
|
|
|
|
|
chomp $configfile; |
1028
|
0
|
0
|
|
|
|
|
if (-e $configfile ) { ; } |
1029
|
0
|
|
|
|
|
|
else { &start; } |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
########################################################################################### |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
sub opt |
1035
|
|
|
|
|
|
|
{ |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
############################################################### |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
|
1040
|
0
|
|
|
0
|
0
|
|
&start; |
1041
|
|
|
|
|
|
|
# eval `cat $configfile`; # The file where the program data are |
1042
|
|
|
|
|
|
|
|
1043
|
0
|
|
|
|
|
|
require $configfile; |
1044
|
0
|
0
|
|
|
|
|
if ( not ( $outfile ) ) { $outfile = "$mypath/$file-$fileconfig-feedback.txt"; } |
|
0
|
|
|
|
|
|
|
1045
|
0
|
0
|
|
|
|
|
if ( not ( $toshell ) ) { $toshell = "$mypath/$file-toshell.txt"; } |
|
0
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
|
1047
|
0
|
|
|
|
|
|
$tee = new IO::Tee(\*STDOUT, ">>$toshell"); # GLOBAL ZZZ |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
# if ($casefile) { eval `cat $casefile` or die; } |
1050
|
|
|
|
|
|
|
# if ($chancefile) { eval `cat $chancefile` or die; } |
1051
|
|
|
|
|
|
|
|
1052
|
0
|
|
|
|
|
|
print "\nNow in Sim::OPT.\n"; |
1053
|
|
|
|
|
|
|
|
1054
|
0
|
0
|
|
|
|
|
open ( OUTFILE, ">>$outfile" ) or die "Can't open $outfile: $!"; |
1055
|
0
|
0
|
|
|
|
|
open ( TOSHELL, ">>$toshell" ) or die "Can't open $toshell: $!"; |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
#unless (-e "$mypath") |
1058
|
|
|
|
|
|
|
#{ |
1059
|
|
|
|
|
|
|
# if ($exeonfiles eq "y") |
1060
|
|
|
|
|
|
|
# { |
1061
|
|
|
|
|
|
|
# `mkdir $mypath`; |
1062
|
|
|
|
|
|
|
# } |
1063
|
|
|
|
|
|
|
#} |
1064
|
|
|
|
|
|
|
#unless (-e "$mypath") |
1065
|
|
|
|
|
|
|
#{ |
1066
|
|
|
|
|
|
|
# print TOSHELL "mkdir $mypath\n\n"; |
1067
|
|
|
|
|
|
|
#} |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
##################################################################################### |
1070
|
|
|
|
|
|
|
# INSTRUCTIONS THAT LAUNCH OPT AT EACH SWEEP (SUBSPACE SEARCH) CYCLE |
1071
|
|
|
|
|
|
|
|
1072
|
0
|
0
|
0
|
|
|
|
if ( not ( ( @chanceseed ) and ( @caseseed ) and ( @chancedata ) ) ) |
|
|
|
0
|
|
|
|
|
1073
|
|
|
|
|
|
|
{ |
1074
|
0
|
0
|
0
|
|
|
|
if ( ( @sweepseed ) and ( @chancedata ) ) # IF THIS VALUE IS DEFINED. TO BE FIXED. ZZZ |
1075
|
|
|
|
|
|
|
{ |
1076
|
0
|
|
|
|
|
|
my $yield = fromsweep_toopt(@sweeps); say $tee "Dumper(\$yield): " . Dumper($yield); |
|
0
|
|
|
|
|
|
|
1077
|
0
|
|
|
|
|
|
my @caseseed = @{ $yield[0] }; say $tee "Dumper(\@caseseed): " . Dumper(@caseseed); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1078
|
0
|
|
|
|
|
|
my @chanceseed = @{ $yield[1] }; say $tee "Dumper(\@chanceseed): " . Dumper(@chanceseed); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
#say $tee "\@chanceseedINI: " . Dumper(@chanceseed); # GLOBAL ZZZ |
1083
|
|
|
|
|
|
|
#say $tee "\@caseseedINI: " . Dumper(@caseseed); # GLOBAL ZZZ |
1084
|
0
|
|
|
|
|
|
@chanceseed = convchanceseed(@chanceseed); #say $tee "convchanceseed Dumper(\@chanceseed): " . Dumper(@chanceseed); # GLOBAL ZZZ |
1085
|
0
|
|
|
|
|
|
@caseseed = convcaseseed( { caseseed => \@caseseed, chanceseed => \@chanceseed } ); #say $tee "convcaseseed Dumper(\@caseseed): " . Dumper(@caseseed) ; # GLOBAL ZZZ |
1086
|
|
|
|
|
|
|
#say $tee "Dumper(\@chancedata): " . Dumper(@chancedata) ; # GLOBAL ZZZ |
1087
|
|
|
|
|
|
|
#say $tee "Dumper(\$dimchance): " . Dumper($dimchance) ; # GLOBAL ZZZ |
1088
|
0
|
|
|
|
|
|
my (@sweeps_); |
1089
|
|
|
|
|
|
|
|
1090
|
0
|
0
|
0
|
|
|
|
if ( ( $target eq "takechance" ) and (@chancedata) and ( $dimchance ) ) |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1091
|
|
|
|
|
|
|
{ |
1092
|
0
|
|
|
|
|
|
my @obt = Sim::OPT::Takechance::takechance( \@caseseed, \@chanceseed, \@chancedata, $dimchance ); say $tee "PASSED: \@sweeps: " . dump(@sweeps); |
|
0
|
|
|
|
|
|
|
1093
|
0
|
|
|
|
|
|
@sweeps_ = @{ $obt[0] }; |
|
0
|
|
|
|
|
|
|
1094
|
0
|
|
|
|
|
|
@caseseed_ = @{ $obt[1] }; |
|
0
|
|
|
|
|
|
|
1095
|
0
|
|
|
|
|
|
@chanceseed_ = @{ $obt[2] }; |
|
0
|
|
|
|
|
|
|
1096
|
0
|
|
|
|
|
|
open (MESSAGE, ">./search_structure_that_may_be_adopted.txt"); |
1097
|
0
|
|
|
|
|
|
say MESSAGE "\@sweeps_ " . Dumper(@sweeps_); |
1098
|
0
|
|
|
|
|
|
say MESSAGE "\THESE VALUES OF \@sweeps IS EQUIVALENT TO THE FOLLOWING VALUES OF \@caseseed AND \@chanceseed: "; |
1099
|
0
|
|
|
|
|
|
say MESSAGE "\n\@caseseed " . Dumper(@caseseed_); |
1100
|
0
|
|
|
|
|
|
say MESSAGE "\n\@chanceseed_ " . Dumper(@chanceseed_); |
1101
|
0
|
|
|
|
|
|
close MESSAGE; |
1102
|
|
|
|
|
|
|
|
1103
|
0
|
0
|
|
|
|
|
if ( not (@sweeps) ) # CONSERVATIVE CONDITION. IT MAY BE CHANCED. ZZZ |
1104
|
|
|
|
|
|
|
{ |
1105
|
0
|
|
|
|
|
|
@sweeps = @sweeps_ ; # say "\@tree: " . Dumper(@tree); |
1106
|
|
|
|
|
|
|
} |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
elsif ( $target eq "opt" ) |
1109
|
|
|
|
|
|
|
{ |
1110
|
|
|
|
|
|
|
#my $itersnum = $varinumbers[$countcase]{$varinumber}; say "\$itersnum: $itersnum"; |
1111
|
|
|
|
|
|
|
#say "dump(\@varinumbers), " . dump(@varinumbers); #say "dumpBEFORE(\@miditers), " . dump(@miditers); |
1112
|
|
|
|
|
|
|
|
1113
|
0
|
|
|
|
|
|
calcoverlaps(@sweeps); # PRODUCES @calcoverlaps WHICH IS globsAL. ZZZ |
1114
|
0
|
|
|
|
|
|
say "VARINUMBERS: " . dump ( @varinumbers ); |
1115
|
0
|
|
|
|
|
|
@mediumiters = calcmediumiters( @varinumbers ); say $tee "BEGINNING dump!(\@mediumiters), " . dump(@mediumiters); # globsALS. ZZZ |
|
0
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
#$itersnum = getitersnum($countcase, $varinumber, @varinumbers); #say "\$itersnum OUT = $itersnum"; |
1117
|
|
|
|
|
|
|
|
1118
|
0
|
|
|
|
|
|
@rootnames = definerootcases(\@sweeps, \@mediumiters); say $tee "BEGINNING \@rootnames " . dump(@rootnames); |
|
0
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
|
1120
|
0
|
|
|
|
|
|
my $countcase = 0; |
1121
|
0
|
|
|
|
|
|
my $countblock = 0; |
1122
|
|
|
|
|
|
|
|
1123
|
0
|
|
|
|
|
|
my @winneritems = populatewinners(\@rootnames, $countcase, $countblock); say $tee "BEGINNING \@winneritems " . dump(@winneritems); |
|
0
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
|
1125
|
0
|
|
|
|
|
|
callcase( { countcase => $countcase, rootnames => \@rootnames, countblock => $countblock, |
1126
|
|
|
|
|
|
|
miditers => \@mediumiters, winneritems => \@winneritems } ); |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
elsif ( ( $target eq "parcoord3d" ) and (@chancedata) and ( $dimchance ) ) |
1129
|
|
|
|
|
|
|
{ |
1130
|
0
|
|
|
|
|
|
Sim::OPT::Parcoord3d::parcoord3d; |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
|
1133
|
0
|
|
|
|
|
|
close(OUTFILE); |
1134
|
0
|
|
|
|
|
|
close(TOSHELL); |
1135
|
0
|
|
|
|
|
|
exit; |
1136
|
|
|
|
|
|
|
} # END |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
############################################################################# |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
1; |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
__END__ |