icuSources/test/perf/perldriver/Output.pm

   1 #!/usr/local/bin/perl
   2
   3 #  ********************************************************************
   4 #  * Copyright (C) 2016 and later: Unicode, Inc. and others.
   5 #  * License & terms of use: http://www.unicode.org/copyright.html#License
   6 #  ********************************************************************
   7 #  ********************************************************************
   8 #  * COPYRIGHT:
   9 #  * Copyright (c) 2002, International Business Machines Corporation and
  10 #  * others. All Rights Reserved.
  11 #  ********************************************************************
  12
  13
  14 use strict;
  15
  16 use Dataset;
  17
  18 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
  19 my $outType = "HTML";
  20 my $html = "noName";
  21 my $inTable;
  22 my @headers;
  23 my @timetypes = ("mean per op", "error per op", "events", "per event");
  24 my %raw;
  25 my $current = "";
  26 my $exp = 0;
  27 my $mult = 1e9; #use nanoseconds
  28 my $perc = 100; #for percent
  29 my $printEvents = 0;
  30 my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
  31 my $legendDone = 0;
  32 my %options;
  33 my $operationIs = "operation";
  34 my $eventIs = "event";
  35
  36 sub startTest {
  37   $current = shift;
  38   $exp = 0;
  39   outputData($current);
  40 }
  41
  42 sub printLeg {
  43   if(!$legendDone) {
  44     my $message;
  45     foreach $message (@_) {
  46       $legend .= "<li>".$message."</li>\n";
  47     }
  48   }
  49 }
  50
  51 sub outputDist {
  52   my $value = shift;
  53   my $percent = shift;
  54   my $mean = $value->getMean;
  55   my $error = $value->getError;
  56   print HTML "<td class=\"";
  57   if($mean > 0) {
  58     print HTML "value";
  59   } else {
  60     print HTML "worse";
  61   }
  62   print HTML "\">";
  63   if($percent) {
  64     print HTML formatPercent(2, $mean);
  65   } else {
  66     print HTML formatNumber(2, $mult, $mean);
  67   }
  68   print HTML "</td>\n";
  69   print HTML "<td class=\"";
  70   if((($error*$mult < 10)&&!$percent) || (($error<10)&&$percent)) {
  71     print HTML "error";
  72   } else {
  73     print HTML "errorLarge";
  74   }
  75   print HTML "\">&plusmn;";
  76   if($percent) {
  77     print HTML formatPercent(2, $error);
  78   } else {
  79     print HTML formatNumber(2, $mult, $error);
  80   }
  81   print HTML "</td>\n";
  82 }
  83
  84 sub outputValue {
  85   my $value = shift;
  86   print HTML "<td class=\"sepvalue\">";
  87   print HTML $value;
  88   #print HTML formatNumber(2, 1, $value);
  89   print HTML "</td>\n";
  90 }
  91
  92 sub startTable {
  93   #my $printEvents = shift;
  94   $inTable = 1;
  95   my $i;
  96   print HTML "<table $TABLEATTR>\n";
  97   print HTML "<tbody>\n";
  98   if($#headers >= 0) {
  99     my ($header, $i);
 100     print HTML "<tr>\n";
 101     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#TestName\">Test Name</a></th>\n";
 102     print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#Ops\">Ops</a></th>\n";
 103     printLeg("<a name=\"Test Name\">TestName</a> - name of the test as set by the test writer\n", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration\n");
 104     if(!$printEvents) {
 105       print HTML "<th colspan=".((4*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
 106     } else {
 107       print HTML "<th colspan=".((2*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
 108       print HTML "<th colspan=".((5*($#headers+1))-2)." class=\"sourceType\">Per Event</th>\n";
 109     }
 110     print HTML "</tr>\n<tr>\n";
 111     if(!$printEvents) {
 112       foreach $header (@headers) {
 113         print HTML "<th class=\"source\" colspan=2><a href=\"#meanop_$header\">$header<br>/op</a></th>\n";
 114         printLeg("<a name=\"meanop_$header\">$header /op</a> - mean time and error for $header per $operationIs");
 115       }
 116     }
 117     for $i (1 .. $#headers) {
 118       print HTML "<th class=\"source\" colspan=2><a href=\"#mean_op_$i\">ratio $i<br>/op</a></th>\n";
 119       printLeg("<a name=\"mean_op_$i\">ratio $i /op</a> - ratio and error of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
 120     }
 121     if($printEvents) {
 122       foreach $header (@headers) {
 123         print HTML "<th class=\"source\"><a href=\"#events_$header\">$header<br>events</a></th>\n";
 124         printLeg("<a name=\"events_$header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
 125       }
 126       foreach $header (@headers) {
 127         print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$header\">$header<br>/ev</a></th>\n";
 128         printLeg("<a name=\"mean_ev_$header\">$header /ev</a> - mean time and error for $header per $eventIs");
 129       }
 130       for $i (1 .. $#headers) {
 131         print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$i\">ratio $i<br>/ev</a></th>\n";
 132         printLeg("<a name=\"mean_ev_$i\">ratio $i /ev</a> - ratio and error of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
 133       }
 134     }
 135     print HTML "</tr>\n";
 136   }
 137   $legendDone = 1;
 138 }
 139
 140 sub closeTable {
 141   if($inTable) {
 142     undef $inTable;
 143     print HTML "</tr>\n";
 144     print HTML "</tbody>";
 145     print HTML "</table>\n";
 146   }
 147 }
 148
 149 sub newRow {
 150   if(!$inTable) {
 151     startTable;
 152   } else {
 153     print HTML "</tr>\n";
 154   }
 155   print HTML "<tr>";
 156 }
 157
 158 sub outputData {
 159   if($inTable) {
 160     my $msg = shift;
 161     my $align = shift;
 162     print HTML "<td";
 163     if($align) {
 164       print HTML " align = $align>";
 165     } else {
 166       print HTML ">";
 167     }
 168     print HTML "$msg";
 169     print HTML "</td>";
 170   } else {
 171     my $message;
 172     foreach $message (@_) {
 173       print HTML "$message";
 174     }
 175   }
 176 }
 177
 178 sub setupOutput {
 179   my $date = localtime;
 180   my $options = shift;
 181   %options = %{ $options };
 182   my $title = $options{ "title" };
 183   my $headers = $options{ "headers" };
 184   if($options{ "operationIs" }) {
 185     $operationIs = $options{ "operationIs" };
 186   }
 187   if($options{ "eventIs" }) {
 188     $eventIs = $options{ "eventIs" };
 189   }
 190   @headers = split(/ /, $headers);
 191   my ($t, $rest);
 192   ($t, $rest) = split(/\.\w+/, $0);
 193   $t =~ /^.*\W(\w+)$/;
 194   $t = $1;
 195   if($outType eq 'HTML') {
 196     $html = $date;
 197     $html =~ s/://g; # ':' illegal
 198     $html =~ s/\s*\d+$//; # delete year
 199     $html =~ s/^\w+\s*//; # delete dow
 200     $html = "$t $html.html";
 201     if($options{ "outputDir" }) {
 202       $html = $options{ "outputDir" }."/".$html;
 203     }
 204     $html =~ s/ /_/g;
 205
 206     open(HTML,">$html") or die "Can't write to $html: $!";
 207
 208 #<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
 209     print HTML <<EOF;
 210 <HTML>
 211    <HEAD>
 212    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
 213       <TITLE>$title</TITLE>
 214 <style>
 215 <!--
 216 body         { font-size: 10pt; font-family: sans-serif }
 217 th           { font-size: 10pt; border: 0 solid #000080; padding: 5 }
 218 th.testNameHeader { border-width: 1 }
 219 th.testName  { text-align: left; border-left-width: 1; border-right-width: 1;
 220                border-bottom-width: 1 }
 221 th.source    { border-right-width: 1; border-bottom-width: 1 }
 222 th.sourceType { border-right-width: 1; border-top-width: 1; border-bottom-width: 1 }
 223 td           { font-size: 10pt; text-align: Right; border: 0 solid #000080; padding: 5 }
 224 td.string    { text-align: Left; border-bottom-width:1; border-right-width:1 }
 225 td.sepvalue  { border-bottom-width: 1; border-right-width: 1 }
 226 td.value     { border-bottom-width: 1 }
 227 td.worse     { color: #FF0000; font-weight: bold; border-bottom-width: 1 }
 228 td.error     { font-size: 75%; border-right-width: 1; border-bottom-width: 1 }
 229 td.errorLarge { font-size: 75%; color: #FF0000; font-weight: bold; border-right-width: 1;
 230                border-bottom-width: 1 }
 231 A:link    { color: black; font-weight: normal; text-decoration: none}    /* unvisited links */
 232 A:visited { color: blue; font-weight: normal; text-decoration: none }   /* visited links   */
 233 A:hover   { color: red; font-weight: normal; text-decoration: none } /* user hovers     */
 234 A:active  { color: lime; font-weight: normal; text-decoration: none }   /* active links    */
 235 -->
 236 </style>
 237    </HEAD>
 238    <BODY bgcolor="#FFFFFF" LINK="#006666" VLINK="#000000">
 239 EOF
 240     print HTML "<H1>$title</H1>\n";
 241
 242     #print HTML "<H2>$TESTCLASS</H2>\n";
 243   }
 244 }
 245
 246 sub closeOutput {
 247   if($outType eq 'HTML') {
 248     if($inTable) {
 249       closeTable;
 250     }
 251     $legend .= "</ul>\n";
 252     print HTML $legend;
 253     outputRaw();
 254     print HTML <<EOF;
 255    </BODY>
 256 </HTML>
 257 EOF
 258     close(HTML) or die "Can't close $html: $!";
 259   }
 260 }
 261
 262
 263 sub outputRaw {
 264   print HTML "<h2>Raw data</h2>";
 265   my $key;
 266   my $i;
 267   my $j;
 268   my $k;
 269   print HTML "<table $TABLEATTR>\n";
 270   for $key (sort keys %raw) {
 271     my $printkey = $key;
 272     $printkey =~ s/\<br\>/ /g;
 273     if($printEvents) {
 274       if($key ne "") {
 275         print HTML "<tr><th class=\"testNameHeader\" colspan = 7>$printkey</td></tr>\n"; # locale and data file
 276       }
 277       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th><th class=\"testName\">events</th></tr>\n";
 278     } else {
 279       if($key ne "") {
 280         print HTML "<tr><th class=\"testName\" colspan = 6>$printkey</td></tr>\n"; # locale and data file
 281       }
 282       print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th></tr>\n";
 283     }
 284     $printkey =~ s/[\<\>\/ ]//g;
 285
 286     my %done;
 287     for $i ( $raw{$key} ) {
 288       print HTML "<tr>";
 289       for $j ( @$i ) {
 290         my ($test, $args);
 291         ($test, $args) = split(/,/, shift(@$j));
 292
 293         print HTML "<th class=\"testName\">";
 294         if(!$done{$test}) {
 295           print HTML "<a name=\"".$printkey."_".$test."\">".$test."</a>";
 296           $done{$test} = 1;
 297         } else {
 298           print HTML $test;
 299         }
 300         print HTML "</th>";
 301
 302         print HTML "<td class=\"string\">".$args."</td>";
 303
 304         print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
 305         print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
 306
 307         my @data = @{ shift(@$j) };
 308         my $ds = Dataset->new(@data);
 309         print HTML "<td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getMean)."</td><td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getError)."</td>";
 310         if($#{ $j } >= 0) {
 311           print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
 312         }
 313         print HTML "</tr>\n";
 314       }
 315     }
 316   }
 317 }
 318
 319 sub store {
 320   $raw{$current}[$exp++] = [@_];
 321 }
 322
 323 sub outputRow {
 324   #$raw{$current}[$exp++] =  [@_];
 325   my $testName = shift;
 326   my @iterPerPass = @{shift(@_)};
 327   my @noopers =  @{shift(@_)};
 328    my @timedata =  @{shift(@_)};
 329   my @noevents;
 330   if($#_ >= 0) {
 331     @noevents =  @{shift(@_)};
 332   }
 333   if(!$inTable) {
 334     if(@noevents) {
 335       $printEvents = 1;
 336       startTable;
 337     } else {
 338       startTable;
 339     }
 340   }
 341   debug("No events: @noevents, $#noevents\n");
 342
 343   my $j;
 344   my $loc = $current;
 345   $loc =~ s/\<br\>/ /g;
 346   $loc =~ s/[\<\>\/ ]//g;
 347
 348   # Finished one row of results. Outputting
 349   newRow;
 350   #outputData($testName, "LEFT");
 351   print HTML "<th class=\"testName\"><a href=\"#".$loc."_".$testName."\">$testName</a></th>\n";
 352   #outputData($iterCount);
 353   #outputData($noopers[0], "RIGHT");
 354   outputValue($noopers[0]);
 355
 356   if(!$printEvents) {
 357     for $j ( 0 .. $#timedata ) {
 358       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
 359       #debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
 360       outputDist($perOperation);
 361     }
 362   }
 363   my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
 364   for $j ( 1 .. $#timedata ) {
 365     my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
 366     my $ratio = $baseLinePO->subtract($perOperation);
 367     $ratio = $ratio->divide($perOperation);
 368     outputDist($ratio, "%");
 369   }
 370   if (@noevents) {
 371     for $j ( 0 .. $#timedata ) {
 372       #outputData($noevents[$j], "RIGHT");
 373       outputValue($noevents[$j]);
 374     }
 375     for $j ( 0 .. $#timedata ) {
 376       my $perEvent =  $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event
 377       #debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n");
 378       outputDist($perEvent);
 379     }
 380     my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
 381     for $j ( 1 .. $#timedata ) {
 382       my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
 383       my $ratio = $baseLinePO->subtract($perOperation);
 384       $ratio = $ratio->divide($perOperation);
 385       outputDist($ratio, "%");
 386     }
 387   }
 388 }
 389
 390
 391 1;
 392
 393 #eof