File Coverage

blib/lib/Sim/OPT/Report.pm
Criterion Covered Total %
statement 68 328 20.7
branch 0 48 0.0
condition 0 3 0.0
subroutine 23 25 92.0
pod 0 2 0.0
total 91 406 22.4


line stmt bran cond sub pod time code
1             package Sim::OPT::Report;
2             # Copyright (C) 2008-2012 by Gian Luca Brunetti and Politecnico di Milano.
3             # This is the module Sim::OPT::Report of Sim::OPT, a program for detailed metadesign managing parametric explorations through the ESP-r building performance simulation platform and performing optimization by block coordinate descent.
4             # This is free software. You can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, version 2.
5             # The content of this module is stale. It has to be entirely re-checked.
6              
7 1     1   8 use v5.14;
  1         2  
8             # use v5.20;
9 1     1   3 use Exporter;
  1         2  
  1         40  
10 1     1   3 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS );
  1         1  
  1         56  
11 1     1   4 use Math::Trig;
  1         1  
  1         131  
12 1     1   3 use Math::Round;
  1         1  
  1         43  
13 1     1   4 use List::Util qw[ min max reduce shuffle];
  1         1  
  1         54  
14 1     1   4 use List::MoreUtils qw(uniq);
  1         1  
  1         5  
15 1     1   304 use List::AllUtils qw(sum);
  1         1  
  1         43  
16 1     1   3 use Statistics::Basic qw(:all);
  1         1  
  1         6  
17 1     1   346 use Set::Intersection;
  1         2  
  1         58  
18 1     1   6 use List::Compare;
  1         2  
  1         26  
19 1     1   5 use IO::Tee;
  1         2  
  1         92  
20 1     1   7 use Sim::OPT;
  1         1  
  1         43  
21 1     1   7 use Sim::OPT::Morph;
  1         1  
  1         30  
22 1     1   4 use Sim::OPT::Sim;
  1         1  
  1         30  
23 1     1   6 use Sim::OPT::Retrieve;
  1         1  
  1         36  
24 1     1   471 use Sim::OPT::Descend;
  1         3  
  1         66  
25 1     1   8 use Sim::OPT::Takechance;
  1         1  
  1         55  
26 1     1   5 use Data::Dumper;
  1         1  
  1         38  
27             #$Data::Dumper::Indent = 0;
28             #$Data::Dumper::Useqq = 1;
29             #$Data::Dumper::Terse = 1;
30 1     1   4 use Data::Dump qw(dump);
  1         2  
  1         37  
31 1     1   4 use feature 'say';
  1         1  
  1         79  
32 1     1   4 no strict;
  1         2  
  1         20  
33 1     1   3 no warnings;
  1         2  
  1         2938  
34              
35             @ISA = qw(Exporter); # our @adamkISA = qw(Exporter);
36             #%EXPORT_TAGS = ( DEFAULT => [qw( &opt &prepare )]); # our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
37             #@EXPORT_OK = qw(); # our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
38              
39             @EXPORT = qw( report mergereports ); # our @EXPORT = qw( );
40              
41             $VERSION = '0.40.0'; # our $VERSION = '';
42              
43             #########################################################################################
44             # HERE FOLLOWS THE CONTENT OF "Sim.pm", Sim::OPT::Sim
45             ##############################################################################
46              
47             sub report # This function retrieves the results of interest from the text file created by the "retrieve" function
48             {
49 0     0 0   my $swap = shift; #say TOSHELL "swapINDESCEND: " . dump($swap);
50 0           my %dat = %$swap;
51 0           my @instances = @{ $dat{instances} }; #say "scalar(\@instances): " . scalar(@instances);
  0            
52 0           my $countcase = $dat{countcase}; #say "dump(\$countcase): " . dump($countcase); # IT WILL BE SHADOWED. CUT ZZZ
53 0           my $countblock = $dat{countblock}; #say "dump(\$countblock): " . dump($countblock); # IT WILL BE SHADOWED. CUT ZZZ
54 0           my %dirfiles = %{ $dat{dirfiles} }; #say "dump(\%dirfiles): " . dump(%dirfiles);
  0            
55            
56 0           $configfile = $main::configfile; #say "dump(\$configfile): " . dump($configfile);
57 0           @sweeps = @main::sweeps; #say "dump(\@sweeps): " . dump(@sweeps);
58 0           @varinumbers = @main::varinumbers; #say "dump(\@varinumbers): " . dump(@varinumbers);
59 0           @mediumiters = @main::mediumiters;
60 0           @rootnames = @main::rootnames; #say "dump(\@rootnames): " . dump(@rootnames);
61 0           %vals = %main::vals; #say "dump(\%vals): " . dump(%vals);
62            
63 0           $mypath = $main::mypath; #say TOSHELL "dumpINDESCEND(\$mypath): " . dump($mypath);
64 0           $exeonfiles = $main::exeonfiles; #say TOSHELL "dumpINDESCEND(\$exeonfiles): " . dump($exeonfiles);
65 0           $generatechance = $main::generatechance;
66 0           $file = $main::file;
67 0           $preventsim = $main::preventsim;
68 0           $fileconfig = $main::fileconfig; #say TOSHELL "dumpINDESCEND(\$fileconfig): " . dump($fileconfig); # NOW GLOBAL. TO MAKE IT PRIVATE, FIX PASSING OF PARAMETERS IN CONTRAINTS PROPAGATION SECONDARY SUBROUTINES
69 0           $outfile = $main::outfile;
70 0           $toshell = $main::toshell;
71 0           $report = $main::report;
72 0           $simnetwork = $main::simnetwork;
73            
74 0           $tee = new IO::Tee(\*STDOUT, ">>$toshell"); # GLOBAL ZZZ
75            
76 0 0         open ( OUTFILE, ">>$outfile" ) or die "Can't open $outfile: $!";
77 0 0         open ( TOSHELL, ">>$toshell" ) or die "Can't open $toshell: $!";
78 0           say "\nNow in Sim::OPT::Report::report.\n";
79 0           say TOSHELL "\n#Now in Sim::OPT::Report::report.\n";
80            
81 0           %dowhat = %main::dowhat;
82              
83 0           @themereports = @main::themereports; #say TOSHELL "dumpINDESCEND(\@themereports): " . dump(@themereports);
84 0           @simtitles = @main::simtitles; #say TOSHELL "dumpINDESCEND(\@simtitles): " . dump(@simtitles);
85 0           @reporttitles = @main::reporttitles;
86 0           @simdata = @main::simdata;
87 0           @retrievedata = @main::retrievedata;
88 0           @keepcolumns = @main::keepcolumns;
89 0           @weights = @main::weights;
90 0           @weightsaim = @main::weightsaim;
91 0           @varthemes_report = @main::varthemes_report;
92 0           @varthemes_variations = @vmain::arthemes_variations;
93 0           @varthemes_steps = @main::varthemes_steps;
94 0           @rankdata = @main::rankdata; # CUT ZZZ
95 0           @rankcolumn = @main::rankcolumn;
96 0           @reporttempsdata = @main::reporttempsdata;
97 0           @reportcomfortdata = @main::reportcomfortdata;
98 0           @reportradiation = @main::reportradiation;
99 0           @report_loadsortemps = @main::report_loadsortemps;
100 0           @files_to_filter = @main::files_to_filter;
101 0           @filter_reports = @main::filter_reports;
102 0           @base_columns = @main::base_columns;
103 0           @maketabledata = @main::maketabledata;
104 0           @filter_columns = @main::filter_columns;
105            
106 0           my @simcases = @{ $dirfiles{simcases} }; #say "dump(\@simcases): " . dump(@simcases);
  0            
107 0           my @simstruct = @{ $dirfiles{simstruct} }; #say "dump(\@simstruct): " . dump(@simstruct);
  0            
108 0           my @INREPORT = @{ $dirfiles{morphcases} };
  0            
109 0           my @morphstruct = @{ $dirfiles{morphstruct} };
  0            
110 0           my @retcases = @{ $dirfiles{retcases} }; #say TOSHELL "dumpINREPORT::report(\@retcases): " . dump(@retcases); say "dumpINDESCEND(\@retcases): " . dump(@retcases);
  0            
111 0           my @retstruct = @{ $dirfiles{retstruct} }; #say "dump(\@retstruct): " . dump(@retstruct);
  0            
112 0           my @repcases = @{ $dirfiles{repcases} };
  0            
113 0           my @repstruct = @{ $dirfiles{repstruct} };
  0            
114 0           my @mergecases = @{ $dirfiles{mergecases} };
  0            
115 0           my @mergestruct = @{ $dirfiles{mergestruct} };
  0            
116 0           my @descendcases = @{ $dirfiles{descendcases} };
  0            
117 0           my @descendstruct = @{ $dirfiles{descendstruct} };
  0            
118            
119 0           my $morphlist = $dirfiles{morphlist}; #say "dump(\$dat{morphlist}): " . dump($dat{morphlist});
120 0           my $morphblock = $dirfiles{morphblock};
121 0           my $simlist = $dirfiles{simlist}; #say "dump(\$simlist): " . dump($simlist);
122 0           my $simblock = $dirfiles{simblock};
123 0           my $retlist = $dirfiles{retlist};
124 0           my $retblock = $dirfiles{retblock};
125 0           my $replist = $dirfiles{replist};
126 0           my $repblock = $dirfiles{repblock};
127 0           my $descendlist = $dirfiles{descendlist};
128 0           my $descendblock = $dirfiles{descendblock};
129            
130             #my $getpars = shift;
131             #eval( $getpars );
132              
133             #if ( fileno (MORPHLIST)
134              
135             #my $getpars = shift;
136             #eval( $getpars );
137            
138 0           my @repfilemem;
139 0           $" = " ";
140 0           my $repfile;
141 0           my $countinstance = 0;
142 0           foreach my $instance (@instances)
143             {
144 0           my %d = %{$instance};
  0            
145 0           my $countcase = $d{countcase}; #say TOSHELL "dump(\$countcase): " . dump($countcase);
146 0           my $countblock = $d{countblock}; #say TOSHELL "dump(\$countblock): " . dump($countblock);
147 0           my @miditers = @{ $d{miditers} }; #say TOSHELL "dump(\@miditers): " . dump(@miditers);
  0            
148 0           my @winneritems = @{ $d{winneritems} }; #say TOSHELL "dumpIN( \@winneritems) " . dump(@winneritems);
  0            
149 0           my $countvar = $d{countvar}; #say TOSHELL "dump(\$countvar): " . dump($countvar);
150 0           my $countstep = $d{countstep}; #say TOSHELL "dump(\$countstep): " . dump($countstep);
151 0           my $to = $d{to}; #say TOSHELL "dump(\$to): " . dump($to);
152 0           my $origin = $d{origin}; #say TOSHELL "dump(\$origin): " . dump($origin);
153 0           my @uplift = @{ $d{uplift} }; #say TOSHELL "dump(\@uplift): " . dump(@uplift);
  0            
154             #eval($getparshere);
155            
156 0           my $rootname = Sim::OPT::getrootname(\@rootnames, $countcase); #say TOSHELL "dump(\$rootname): " . dump($rootname);
157 0           my @blockelts = Sim::OPT::getblockelts(\@sweeps, $countcase, $countblock); #say TOSHELL "dumpIN( \@blockelts) " . dump(@blockelts);
158 0           my @blocks = Sim::OPT::getblocks(\@sweeps, $countcase); #say TOSHELL "dumpIN( \@blocks) " . dump(@blocks);
159 0           my $toitem = Sim::OPT::getitem(\@winneritems, $countcase, $countblock); #say TOSHELL "dump(\$toitem): " . dump($toitem);
160 0           my $from = Sim::OPT::getline($toitem); #say TOSHELL "dumpIN(\$from): " . dump($from);
161 0           my %varnums = Sim::OPT::getcase(\@varinumbers, $countcase); #say TOSHELL "dumpIN---(\%varnums): " . dump(%varnums);
162 0           my %mids = Sim::OPT::getcase(\@miditers, $countcase); #say TOSHELL "dumpIN---(\%mids): " . dump(%mids);
163             #eval($getfly);
164            
165 0           my $stepsvar = Sim::OPT::getstepsvar($countvar, $countcase, \@varinumbers); #say TOSHELL "dump(\$stepsvar): " . dump($stepsvar);
166 0           my $varnumber = $countvar; #say TOSHELL "dump---(\$varnumber): " . dump($varnumber) . "\n\n"; # LEGACY VARIABLE
167              
168 0           say TOSHELL "#Processing reports for case " . ($countcase + 1) . ", block " . ($countblock + 1);
169             #say "THEMEREPORTS::report: " . dump (@themereports);
170             #say TOSHELL "THEMEREPORTS::report: " . dump (@themereports);
171            
172 0 0         open ( REPLIST, ">>$replist" ) or die;
173 0 0         open ( REPBLOCK, ">>$repblock" ) or die;
174 0           $repfile = "$file-report-$countcase-$countblock.txt";
175            
176 0           push ( @{ $repstruct[$countcase][$countblock] }, $repfile );
  0            
177 0           say REPBLOCK "$repfile";
178 0 0         if ( not ( $repfile ~~ @repcases ) )
179             {
180 0           push ( @repcases, $repfile );
181 0           say REPLIST "$repfile";
182             }
183              
184 0 0         open ( REPFILE, ">>$repfile") or die "Can't open $repfile $!";
185            
186 0           my $counttheme = 0;
187 0           foreach my $themeref (@themereports)
188             {
189 0           my $simtitle = $simtitles[$counttheme]; say TOSHELL "\$simtitle " . dump($simtitle); ###
  0            
190            
191 0           my $countreport = 0;
192 0           foreach my $themereport ( @$themeref ) ###
193             {
194 0           $" = " ";
195 0           my $reporttitle = $reporttitles[$counttheme][$countreport]; say TOSHELL "CALLING-PRE\$reporttitle " . dump($reporttitle);
  0            
196 0           my $simdatum = $reporttitles[$counttheme][0]; say TOSHELL "CALLING-PRE\$simdatum " . dump($simdatum);
  0            
197 0           my @retrievs = @{ $retrievedata[$counttheme][$countreport] }; say TOSHELL "CALLING-PRE\@retrievs " . dump(@retrievs);
  0            
  0            
198 0           my $loadsortemps = $report_loadsortemps[$counttheme][$countreport]; say TOSHELL "CALLING-PRE\$loadsortemps " . dump($loadsortemps);
  0            
199            
200 0           my $retfile = $retstruct[$countcase][$countblock][$counttheme][$countreport][$countinstance] ; say TOSHELL "#\$retfile " . dump($retfile);
  0            
201 0           say TOSHELL "#CALLING-REPSTRUCT " . dump(@repstruct); # ZZZ
202            
203 0           say TOSHELL "CALLING-\$themereport: " . dump($themereport);
204 0           say TOSHELL "CALLING-\$countcase: " . dump($countcase);
205 0           say TOSHELL "CALLING-\$countblock: " . dump($countblock);
206 0           say TOSHELL "CALLING-\$themereport " . dump($themereport);
207 0           say TOSHELL "CALLING-\$counttheme " . dump($counttheme);
208 0           say TOSHELL "CALLING-\$countreport " . dump($countreport);
209 0           say TOSHELL "CALLING-\$retfile: " . dump($retfile);
210 0           say TOSHELL "CALLING-\$repfile: " . dump($repfile);
211 0           say TOSHELL "repfilemem BEFORE: " . dump( @repfilemem );
212 0           @repfilemem = get_files($themereport, $countcase, $countblock, $counttheme, $countreport, $retfile, $repfile, $simtitle,
213             $reporttitle, $simdatum, \@retrievs, $countinstance, \@repfilemem, $loadsortemps );
214 0           say TOSHELL "repfilemem AFTER: " . dump( @repfilemem );
215              
216 0           $countreport++;
217             }
218 0           $counttheme++;
219             }
220 0           $countinstance++;
221             }
222            
223 0           push ( @{ $mergestruct[$countcase][$countblock] }, @repfilemem ); say TOSHELL "\@mergestruct: " . dump(@mergestruct);
  0            
  0            
224            
225             #if ( @repfilemem ~~ @mergecases )
226             #{
227             # push ( @mergecases, @repfilemem );
228             #}
229 0           say TOSHELL "\@repfilemem ~~ \@mergecases.";
230            
231 0           foreach my $instref ( @{ $mergestruct[$countcase][$countblock] } )
  0            
232             {
233 0           my @instance = @{ $instref };
  0            
234 0           foreach (@instance)
235             {
236 0           print REPFILE "$_"; say TOSHELL " INSTANCE " . dump($_);
  0            
237             }
238 0           print REPFILE "\n";
239             }
240 0           close REPFILE;
241            
242 0           say TOSHELL "\$repfile: " . dump($repfile);
243 0           close TOSHELL;
244 0           close OUTFILE;
245 0           return ( \@repcases, \@repstruct, \@mergestruct, \@mergecases, $repfile );
246             } # END SUB report;
247              
248              
249             sub get_files
250             {
251 0     0 0   say "Extracting statistics for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", instance: " . ( $countinstance + 1);
252 0           say TOSHELL "
253             #Extracting statistics for case " . ($countcase + 1) . ", block " . ($countblock + 1) . ", instance: " . ( $countinstance + 1);
254 0           my ( $themereport, $countcase, $countblock, $counttheme, $countreport, $retfile, $repfile,
255             $simtitle, $reporttitle, $simdatum, $retrievsref, $countinstance, $swap, $loadsortemps ) = @_;
256            
257 0           say TOSHELL "#CALLED-REPSTRUCT " . dump(@repstruct); # ZZZ
258 0           say TOSHELL "CALLED-\$themereport: " . dump($themereport);
259 0           say TOSHELL "CALLED-\$countcase: " . dump($countcase);
260 0           say TOSHELL "CALLED-\$countblock: " . dump($countblock);
261 0           say TOSHELL "CALLED-\$themereport " . dump($themereport);
262 0           say TOSHELL "CALLED-\$counttheme " . dump($counttheme);
263 0           say TOSHELL "CALLED-\$countreport " . dump($countreport);
264 0           say TOSHELL "CALLED-\$retfile: " . dump($retfile);
265 0           say TOSHELL "CALLED-\$repfile: " . dump($repfile);
266 0           say TOSHELL "CALLED-\$loadsortemps " . dump($loadsortemps);
267 0           say TOSHELL "repfilemem CALLED " . dump( @repfilemem );
268            
269 0           my @repfilemem = @$swap; #say TOSHELL "CALLED-\@repfilemem " . dump(@repfilemem);
270 0           my @retrievs = @$retrievsref;
271            
272 0           my @measurements_to_report = $retrievs[0]; #say TOSHELL "CALLED-\@measurements_to_report " . dump(@measurements_to_report);
273 0           my $dates_to_report = $simtitle; #say TOSHELL "CALLED-\$dates_to_report " . dump($dates_to_report);
274            
275 0           say TOSHELL "CALLED\$loadsortemps: " . $loadsortemps; say TOSHELL "\$retfile! " . $retfile;
  0            
276 0 0         open( RETFILE, "$retfile" ) or die "Can't open $retfile $!";
277 0           my @lines_to_inspect = ; say TOSHELL "CALLED-\@lines_to_inspect " . dump(@lines_to_inspect);
  0            
278              
279 0           my @countcolumns;
280 0           my $countzones = 0;
281 0           my $countlines = 0;
282 0           foreach my $line_to_inspect (@lines_to_inspect)
283             {
284 0 0         if ( $line_to_inspect )
285             {
286            
287 0           $line_to_inspect =~ s/^\s+//g;### DO THIS? ZZZ
288 0           $line_to_inspect =~ s/\s*$//; #remove trailing whitespace
289             #$line_to_inspect =~ s/\ {2,}/ /g; #remove multiple literal spaces
290 0           $line_to_inspect =~ s/\t{2,}/\t/g; say TOSHELL "line_to_inspect: $line_to_inspect";
  0            
291            
292 0 0         if ( $themereport eq "temps" ) # NEVER CHECKED IF IT STILL WORKS AFTER SOME USES
293             {
294 0           my @roww = split( /\s+/, $line_to_inspect );
295 0 0         if ( $countlines == 1 )
    0          
    0          
296             {
297 0           $file_and_period = $roww[5];
298             }
299             elsif ( $countlines == 3 )
300             {
301 0           my $countcolumn = 0;
302 0           foreach $elt_of_row (@roww)
303             { #
304 0           foreach $column (@columns_to_report)
305             {
306 0 0         if ( $elt_of_row eq $column )
307             {
308 0           push @countcolumns, $countcolumn;
309 0 0         if ( $elt_of_row eq $columns_to_report[0] )
310             {
311 0           $title_of_column = "$elt_of_row";
312             } else
313             {
314 0           $title_of_column = "$elt_of_row-" . "$file_and_period";
315             }
316 0           push ( @{ $repfilemem[$countinstance] }, "$title_of_column\t" );
  0            
317             }
318             }
319 0           $countcolumn = $countcolumn + 1;
320             }
321             #push ( @{ $repfilemem[$countlines] }, "\n" );
322             }
323             elsif ( $countlines > 3 )
324             {
325 0           foreach $columnumber (@countcolumns)
326             {
327 0 0         if ( $columnumber =~ /\d/ )
328             {
329 0           push ( @{ $repfilemem[$countinstance] }, "$roww[$columnumber]\t" );
  0            
330             }
331             }
332             #push ( @{ $repfilemem[$countlines] }, "\n" );
333             }
334 0           $countlines++;
335             }
336            
337 0 0         if ( $themereport eq "comfort" ) # NEVER CHECKED IF IT STILL WORKS AFTER SOME USES
338             {
339 0           my @roww = split( /\s+/, $line_to_inspect );
340              
341 0 0         if ( $countlines == 1 )
    0          
    0          
342             {
343 0           $file_and_period = $roww[5];
344             }
345             elsif ( $countlines == 3 )
346             {
347 0           my $countcolumn = 0;
348 0           foreach $elt_of_row (@roww)
349             { #
350 0           foreach $column (@columns_to_report)
351             {
352 0 0         if ( $elt_of_row eq $column )
353             {
354 0           push @countcolumns, $countcolumn;
355 0 0         if ( $elt_of_row eq $columns_to_report[0] )
356             {
357 0           $title_of_column = "$elt_of_row";
358             } else
359             {
360 0           $title_of_column =
361             "$elt_of_row-" . "$file_and_period";
362             }
363 0           push ( @{ $repfilemem[$countinstance] }, "$title_of_column\t" );
  0            
364             }
365             }
366 0           $countcolumn = $countcolumn + 1;
367             }
368             #push ( @{ $repfilemem[$countlines] }, "\n" );
369             }
370             elsif ( $countlines > 3 )
371             {
372 0           foreach $columnumber (@countcolumns)
373             {
374 0 0         if ( $columnumber =~ /\d/ )
375             {
376 0           push ( @{ $repfilemem[$countinstance] }, "$roww[$columnumber]\t" );
  0            
377             }
378             }
379             #push ( @{ $repfilemem[$countlines] }, "\n" );
380             }
381 0           $countlines++;
382             }
383            
384 0           my $line_to_report;
385 0           say TOSHELL "\$loadsortemps: $loadsortemps";
386 0 0 0       if ( ( $themereport eq "loads" ) or ( $themereport eq "tempsstats" ) )
387             {
388 0 0         if ( $line_to_inspect =~ /^$loadsortemps/ )
389             {
390 0           $line_to_report = "$retfile " . " $themereport $reporttitle " . $line_to_inspect . " " ;
391 0           $line_to_report =~ s/--//g;
392 0           $line_to_report =~ s/\s+/ /g; #remove multiple literal spaces
393 0           $line_to_report =~ s/ /,/g; #remove multiple literal spaces
394 0           push ( @{ $repfilemem[$countinstance] }, $line_to_report );
  0            
395             }
396 0           $countlines++;
397             }
398             }
399             }
400 0           say TOSHELL "LEAVING \@repfilemem " . dump(@repfilemem);
401 0           return (@repfilemem);
402             } # END SUB get_files
403              
404             1;