icuSources/test/perf/perldriver/Output.pm

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