jars/icu4j-52_1/perf-tests/ucharacterperf.pl

   1 #!/usr/local/bin/perl
   2 # *******************************************************************************
   3 # * Copyright (C) 2002-2007 International Business Machines Corporation and     *
   4 # * others. All Rights Reserved.                                                *
   5 # *******************************************************************************
   6
   7 use strict;
   8
   9 # Assume we are running within the icu4j root directory
  10 use lib 'src/com/ibm/icu/dev/test/perf';
  11 use Dataset;
  12
  13 #---------------------------------------------------------------------
  14 # Test class
  15 my $TESTCLASS = 'com.ibm.icu.dev.test.perf.UCharacterPerf';
  16
  17 # Methods to be tested.  Each pair represents a test method and
  18 # a baseline method which is used for comparison.
  19 my @METHODS  = (['JDKDigit',                    'Digit'],
  20                 ['JDKGetNumericValue',          'GetNumericValue'],
  21                 ['JDKGetType',                  'GetType'],
  22                 ['JDKIsDefined',                'IsDefined'],
  23                 ['JDKIsDigit',                  'IsDigit'],
  24                 ['JDKIsIdentifierIgnorable',    'IsIdentifierIgnorable'],
  25                 ['JDKIsISOControl',             'IsISOControl'],
  26                 ['JDKIsLetter',                 'IsLetter'],
  27                 ['JDKIsLetterOrDigit',          'IsLetterOrDigit'],
  28                 ['JDKIsLowerCase',              'IsLowerCase'],
  29                 ['JDKIsSpaceChar',              'IsSpaceChar'],
  30                 ['JDKIsTitleCase',              'IsTitleCase'],
  31                 ['JDKIsUnicodeIdentifierPart',  'IsUnicodeIdentifierPart'],
  32                 ['JDKIsUnicodeIdentifierStart', 'IsUnicodeIdentifierStart'],
  33                 ['JDKIsUpperCase',              'IsUpperCase'],
  34                 ['JDKIsWhiteSpace',             'IsWhiteSpace'],
  35                );
  36
  37 # Patterns which define the set of characters used for testing.
  38 my @PATTERNS = ('0 ffff');
  39
  40 my $CALIBRATE = 2;  # duration in seconds for initial calibration
  41 my $DURATION  = 10; # duration in seconds for each pass
  42 my $NUMPASSES = 4;  # number of passes.  If > 1 then the first pass
  43                     # is discarded as a JIT warm-up pass.
  44
  45 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
  46
  47 my $PLUS_MINUS = "&plusmn;";
  48
  49 if ($NUMPASSES < 3) {
  50     die "Need at least 3 passes.  One is discarded (JIT warmup) and need two to have 1 degree of freedom (t distribution).";
  51 }
  52
  53 my $OUT; # see out()
  54
  55 main();
  56
  57 #---------------------------------------------------------------------
  58 # ...
  59 sub main {
  60     my $date = localtime;
  61     my $title = "ICU4J Performance Test $date";
  62
  63     my $html = $date;
  64     $html =~ s/://g; # ':' illegal
  65     $html =~ s/\s*\d+$//; # delete year
  66     $html =~ s/^\w+\s*//; # delete dow
  67     $html = "perf $html.html";
  68
  69     open(HTML,">$html") or die "Can't write to $html: $!";
  70
  71     print HTML <<EOF;
  72 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
  73    "http://www.w3.org/TR/html4/strict.dtd">
  74 <HTML>
  75    <HEAD>
  76       <TITLE>$title</TITLE>
  77    </HEAD>
  78    <BODY>
  79 EOF
  80     print HTML "<H1>$title</H1>\n";
  81
  82     print HTML "<H2>$TESTCLASS</H2>\n";
  83
  84     my $raw = "";
  85
  86     for my $methodPair (@METHODS) {
  87
  88         my $testMethod = $methodPair->[0];
  89         my $baselineMethod = $methodPair->[1];
  90
  91         print HTML "<P><TABLE $TABLEATTR><TR><TD>\n";
  92         print HTML "<P><B>$testMethod vs. $baselineMethod</B></P>\n";
  93
  94         print HTML "<P><TABLE $TABLEATTR BGCOLOR=\"#CCFFFF\">\n";
  95         print HTML "<TR><TD>Pattern</TD><TD>$testMethod</TD>";
  96         print HTML "<TD>$baselineMethod</TD><TD>Ratio</TD></TR>\n";
  97
  98         $OUT = '';
  99
 100         for my $pat (@PATTERNS) {
 101             print HTML "<TR><TD>$pat</TD>\n";
 102
 103             out("<P><TABLE $TABLEATTR WIDTH=\"100%\">");
 104
 105             # measure the test method
 106             out("<TR><TD>");
 107             print "\n$testMethod $pat\n";
 108             my $t = measure2($testMethod, $pat, -$DURATION);
 109             out("</TD></TR>");
 110             print HTML "<TD>", formatSeconds(4, $t->getMean(), $t->getError);
 111             print HTML "/event</TD>\n";
 112
 113             # measure baseline method
 114             out("<TR><TD>");
 115             print "\nBegin $baselineMethod $pat\n";
 116             my $b = measure2($baselineMethod, $pat, -$DURATION);
 117             out("</TD></TR>");
 118             print HTML "<TD>", formatSeconds(4, $b->getMean(), $t->getError);
 119             print HTML "/event</TD>\n";
 120
 121             out("</TABLE></P>");
 122
 123             # output ratio
 124             my $r = $t->divide($b);
 125             my $mean = $r->getMean() - 1;
 126             my $color = $mean < 0 ? "RED" : "BLACK";
 127             print HTML "<TD><B><FONT COLOR=\"$color\">", formatPercent(3, $mean, $r->getError);
 128             print HTML "</FONT></B></TD></TR>\n";
 129         }
 130
 131         print HTML "</TABLE></P>\n";
 132
 133         print HTML "<P>Raw data:</P>\n";
 134         print HTML $OUT;
 135         print HTML "</TABLE></P>\n";
 136     }
 137
 138     print HTML <<EOF;
 139    </BODY>
 140 </HTML>
 141 EOF
 142     close(HTML) or die "Can't close $html: $!";
 143 }
 144
 145 #---------------------------------------------------------------------
 146 # Append text to the global variable $OUT
 147 sub out {
 148     $OUT .= join('', @_);
 149 }
 150
 151 #---------------------------------------------------------------------
 152 # Append text to the global variable $OUT
 153 sub outln {
 154     $OUT .= join('', @_) . "\n";
 155 }
 156
 157 #---------------------------------------------------------------------
 158 # Measure a given test method with a give test pattern using the
 159 # global run parameters.
 160 #
 161 # @param the method to run
 162 # @param the pattern defining characters to test
 163 # @param if >0 then the number of iterations per pass.  If <0 then
 164 #        (negative of) the number of seconds per pass.
 165 #
 166 # @return a Dataset object, scaled by iterations per pass and
 167 #         events per iteration, to give time per event
 168 #
 169 sub measure2 {
 170     my @data = measure1(@_);
 171     my $iterPerPass = shift(@data);
 172     my $eventPerIter = shift(@data);
 173
 174     shift(@data) if (@data > 1); # discard first run
 175
 176     my $ds = Dataset->new(@data);
 177     $ds->setScale(1.0e-3 / ($iterPerPass * $eventPerIter));
 178     $ds;
 179 }
 180
 181 #---------------------------------------------------------------------
 182 # Measure a given test method with a give test pattern using the
 183 # global run parameters.
 184 #
 185 # @param the method to run
 186 # @param the pattern defining characters to test
 187 # @param if >0 then the number of iterations per pass.  If <0 then
 188 #        (negative of) the number of seconds per pass.
 189 #
 190 # @return array of:
 191 #         [0] iterations per pass
 192 #         [1] events per iteration
 193 #         [2..] ms reported for each pass, in order
 194 #
 195 sub measure1 {
 196     my $method = shift;
 197     my $pat = shift;
 198     my $iterCount = shift; # actually might be -seconds/pass
 199
 200     out("<P>Measuring $method using $pat, ");
 201     if ($iterCount > 0) {
 202         out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
 203     } else {
 204         out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
 205     }
 206
 207     # is $iterCount actually -seconds/pass?
 208     if ($iterCount < 0) {
 209
 210         # calibrate: estimate ms/iteration
 211         print "Calibrating...";
 212         my @t = callJava($method, $pat, -$CALIBRATE, 1);
 213         print "done.\n";
 214
 215         my @data = split(/\s+/, $t[0]->[2]);
 216         $data[0] *= 1.0e+3;
 217
 218         my $timePerIter = 1.0e-3 * $data[0] / $data[1];
 219
 220         # determine iterations/pass
 221         $iterCount = int(-$iterCount / $timePerIter + 0.5);
 222
 223         out("<P>Calibration pass ($CALIBRATE sec): ");
 224         out("$data[0] ms, ");
 225         out("$data[1] iterations = ");
 226         out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
 227     }
 228
 229     # run passes
 230     print "Measuring $iterCount iterations x $NUMPASSES passes...";
 231     my @t = callJava($method, $pat, $iterCount, $NUMPASSES);
 232     print "done.\n";
 233     my @ms = ();
 234     my @b; # scratch
 235     for my $a (@t) {
 236         # $a->[0]: method name, corresponds to $method
 237         # $a->[1]: 'begin' data, == $iterCount
 238         # $a->[2]: 'end' data, of the form <ms> <loops> <eventsPerIter>
 239         # $a->[3...]: gc messages from JVM during pass
 240         @b = split(/\s+/, $a->[2]);
 241         push(@ms, $b[0] * 1.0e+3);
 242     }
 243     my $eventsPerIter = $b[2];
 244
 245     out("Iterations per pass: $iterCount<BR>\n");
 246     out("Events per iteration: $eventsPerIter<BR>\n");
 247
 248     my @ms_str = @ms;
 249     $ms_str[0] .= " (discarded)" if (@ms_str > 1);
 250     out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
 251
 252     ($iterCount, $eventsPerIter, @ms);
 253 }
 254
 255 #---------------------------------------------------------------------
 256 # Invoke java to run $TESTCLASS, passing it the given parameters.
 257 #
 258 # @param the method to run
 259 # @param the number of iterations, or if negative, the duration
 260 #        in seconds.  If more than on pass is desired, pass in
 261 #        a string, e.g., "100 100 100".
 262 # @param the pattern defining characters to test, values in hex digits without 0x
 263 #
 264 # @return an array of results.  Each result is an array REF
 265 #         describing one pass.  The array REF contains:
 266 #         ->[0]: The method name as reported
 267 #         ->[1]: The params on the '= <meth> begin ...' line
 268 #         ->[2]: The params on the '= <meth> end ...' line
 269 #         ->[3..]: GC messages from the JVM, if any
 270 #
 271 sub callJava {
 272     my $method = shift;
 273     my $pat = shift;
 274     my $n = shift;
 275     my $passes = shift;
 276
 277     my $n = ($n < 0) ? "-t ".(-$n) : "-i ".$n;
 278
 279     my $cmd = "java -cp classes $TESTCLASS $method $n -p $passes $pat";
 280     print "[$cmd]\n"; # for debugging
 281     open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
 282     my @out;
 283     while (<PIPE>) {
 284         push(@out, $_);
 285     }
 286     close(PIPE) or die "Java failed: \"$cmd\"";
 287
 288     @out = grep(!/^\#/, @out);  # filter out comments
 289
 290     #print "[", join("\n", @out), "]\n";
 291
 292     my @results;
 293     my $method = '';
 294     my $data = [];
 295     foreach (@out) {
 296         next unless (/\S/);
 297
 298         if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
 299             my ($m, $state, $d) = ($1, $2, $3);
 300             #print "$_ => [[$m $state $data]]\n";
 301             if ($state eq 'begin') {
 302                 die "$method was begun but not finished" if ($method);
 303                 $method = $m;
 304                 push(@$data, $d);
 305                 push(@$data, ''); # placeholder for end data
 306             } elsif ($state eq 'end') {
 307                 if ($m ne $method) {
 308                     die "$method end does not match: $_";
 309                 }
 310                 $data->[1] = $d; # insert end data at [1]
 311                 #print "#$method:", join(";",@$data), "\n";
 312                 unshift(@$data, $method); # add method to start
 313
 314                 push(@results, $data);
 315                 $method = '';
 316                 $data = [];
 317             } else {
 318                 die "Can't parse: $_";
 319             }
 320         }
 321
 322         elsif (/^\[/) {
 323             if ($method) {
 324                 push(@$data, $_);
 325             } else {
 326                 # ignore extraneous GC notices
 327             }
 328         }
 329
 330         else {
 331             die "Can't parse: $_";
 332         }
 333     }
 334
 335     die "$method was begun but not finished" if ($method);
 336
 337     @results;
 338 }
 339
 340 #|#---------------------------------------------------------------------
 341 #|# Format a confidence interval, as given by a Dataset.  Output is as
 342 #|# as follows:
 343 #|#   241.23 - 241.98 => 241.5 +/- 0.3
 344 #|#   241.2 - 243.8 => 242 +/- 1
 345 #|#   211.0 - 241.0 => 226 +/- 15 or? 230 +/- 20
 346 #|#   220.3 - 234.3 => 227 +/- 7
 347 #|#   220.3 - 300.3 => 260 +/- 40
 348 #|#   220.3 - 1000 => 610 +/- 390 or? 600 +/- 400
 349 #|#   0.022 - 0.024 => 0.023 +/- 0.001
 350 #|#   0.022 - 0.032 => 0.027 +/- 0.005
 351 #|#   0.022 - 1.000 => 0.5 +/- 0.5
 352 #|# In other words, take one significant digit of the error value and
 353 #|# display the mean to the same precision.
 354 #|sub formatDataset {
 355 #|    my $ds = shift;
 356 #|    my $lower = $ds->getMean() - $ds->getError();
 357 #|    my $upper = $ds->getMean() + $ds->getError();
 358 #|    my $scale = 0;
 359 #|    # Find how many initial digits are the same
 360 #|    while ($lower < 1 ||
 361 #|           int($lower) == int($upper)) {
 362 #|        $lower *= 10;
 363 #|        $upper *= 10;
 364 #|        $scale++;
 365 #|    }
 366 #|    while ($lower >= 10 &&
 367 #|           int($lower) == int($upper)) {
 368 #|        $lower /= 10;
 369 #|        $upper /= 10;
 370 #|        $scale--;
 371 #|    }
 372 #|}
 373
 374 #---------------------------------------------------------------------
 375 # Format a number, optionally with a +/- delta, to n significant
 376 # digits.
 377 #
 378 # @param significant digit, a value >= 1
 379 # @param multiplier
 380 # @param time in seconds to be formatted
 381 # @optional delta in seconds
 382 #
 383 # @return string of the form "23" or "23 +/- 10".
 384 #
 385 sub formatNumber {
 386     my $sigdig = shift;
 387     my $mult = shift;
 388     my $a = shift;
 389     my $delta = shift; # may be undef
 390
 391     my $result = formatSigDig($sigdig, $a*$mult);
 392     if (defined($delta)) {
 393         my $d = formatSigDig($sigdig, $delta*$mult);
 394         # restrict PRECISION of delta to that of main number
 395         if ($result =~ /\.(\d+)/) {
 396             # TODO make this work for values with all significant
 397             # digits to the left of the decimal, e.g., 1234000.
 398
 399             # TODO the other thing wrong with this is that it
 400             # isn't rounding the $delta properly.  Have to put
 401             # this logic into formatSigDig().
 402             my $x = length($1);
 403             $d =~ s/\.(\d{$x})\d+/.$1/;
 404         }
 405         $result .= " $PLUS_MINUS " . $d;
 406     }
 407     $result;
 408 }
 409
 410 #---------------------------------------------------------------------
 411 # Format a time, optionally with a +/- delta, to n significant
 412 # digits.
 413 #
 414 # @param significant digit, a value >= 1
 415 # @param time in seconds to be formatted
 416 # @optional delta in seconds
 417 #
 418 # @return string of the form "23 ms" or "23 +/- 10 ms".
 419 #
 420 sub formatSeconds {
 421     my $sigdig = shift;
 422     my $a = shift;
 423     my $delta = shift; # may be undef
 424
 425     my @MULT = (1   , 1e3,  1e6,  1e9);
 426     my @SUFF = ('s' , 'ms', 'us', 'ns');
 427
 428     # Determine our scale
 429     my $i = 0;
 430     ++$i while ($a*$MULT[$i] < 1 && $i < @MULT);
 431
 432     formatNumber($sigdig, $MULT[$i], $a, $delta) . ' ' . $SUFF[$i];
 433 }
 434
 435 #---------------------------------------------------------------------
 436 # Format a percentage, optionally with a +/- delta, to n significant
 437 # digits.
 438 #
 439 # @param significant digit, a value >= 1
 440 # @param value to be formatted, as a fraction, e.g. 0.5 for 50%
 441 # @optional delta, as a fraction
 442 #
 443 # @return string of the form "23 %" or "23 +/- 10 %".
 444 #
 445 sub formatPercent {
 446     my $sigdig = shift;
 447     my $a = shift;
 448     my $delta = shift; # may be undef
 449
 450     formatNumber($sigdig, 100, $a, $delta) . ' %';
 451 }
 452
 453 #---------------------------------------------------------------------
 454 # Format a number to n significant digits without using exponential
 455 # notation.
 456 #
 457 # @param significant digit, a value >= 1
 458 # @param number to be formatted
 459 #
 460 # @return string of the form "1234" "12.34" or "0.001234".  If
 461 #         number was negative, prefixed by '-'.
 462 #
 463 sub formatSigDig {
 464     my $n = shift() - 1;
 465     my $a = shift;
 466
 467     local $_ = sprintf("%.${n}e", $a);
 468     my $sign = (s/^-//) ? '-' : '';
 469
 470     my $a_e;
 471     my $result;
 472     if (/^(\d)\.(\d+)e([-+]\d+)$/) {
 473         my ($d, $dn, $e) = ($1, $2, $3);
 474         $a_e = $e;
 475         $d .= $dn;
 476         $e++;
 477         $d .= '0' while ($e > length($d));
 478         while ($e < 1) {
 479             $e++;
 480             $d = '0' . $d;
 481         }
 482         if ($e == length($d)) {
 483             $result = $sign . $d;
 484         } else {
 485             $result = $sign . substr($d, 0, $e) . '.' . substr($d, $e);
 486         }
 487     } else {
 488         die "Can't parse $_";
 489     }
 490     $result;
 491 }
 492
 493 #eof