File Coverage

blib/lib/Sim/OPT.pm
Criterion Covered Total %
statement 74 699 10.5
branch 0 68 0.0
condition 0 39 0.0
subroutine 25 69 36.2
pod 0 42 0.0
total 99 917 10.8


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__