jars/icu4j-4_2_1-src/src/com/ibm/icu/dev/test/perf/perldriver/Output.pm

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