Home | History | Annotate | Download | only in perf-tests 
      1 #!/usr/local/bin/perl
      2 # *  2016 and later: Unicode, Inc. and others.
      3 # * License & terms of use: http://www.unicode.org/copyright.html#License
      4 # *******************************************************************************
      5 # * Copyright (C) 2002-2007 International Business Machines Corporation and     *
      6 # * others. All Rights Reserved.                                                *
      7 # *******************************************************************************
      8 
      9 use strict;
     10 
     11 # Assume we are running within the icu4j root directory
     12 use lib 'src/com/ibm/icu/dev/test/perf';
     13 use Dataset;
     14 
     15 #---------------------------------------------------------------------
     16 # Test class
     17 my $TESTCLASS = 'com.ibm.icu.dev.test.perf.DecimalFormatPerformanceTest';
     18 
     19 # Methods to be tested.  Each pair represents a test method and
     20 # a baseline method which is used for comparison.
     21 my @METHODS  = (
     22                  ['TestJDKConstruction',     'TestICUConstruction'],
     23                  ['TestJDKParse',            'TestICUParse'],
     24                  ['TestJDKFormat',           'TestICUFormat']
     25                );
     26 # Patterns which define the set of characters used for testing.
     27 my @OPTIONS = (
     28 #                 locale    pattern      date string
     29                 [ "en_US",  "#,###.##",  "1,234.56"],
     30                 [ "de_DE",  "#,###.##",  "1.234,56"],
     31               );
     32 
     33 my $THREADS;        # number of threads (input from command-line args)
     34 my $CALIBRATE = 2;  # duration in seconds for initial calibration
     35 my $DURATION  = 10; # duration in seconds for each pass
     36 my $NUMPASSES = 4;  # number of passes.  If > 1 then the first pass
     37                     # is discarded as a JIT warm-up pass.
     38 
     39 my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
     40 
     41 my $PLUS_MINUS = "±";
     42 
     43 if ($NUMPASSES < 3) {
     44     die "Need at least 3 passes.  One is discarded (JIT warmup) and need two to have 1 degree of freedom (t distribution).";
     45 }
     46 
     47 my $OUT; # see out()
     48 
     49 # run all tests with the specified number of threads from command-line input
     50 # (if there is no arguments, use $THREADS = 1)
     51 foreach my $arg ($#ARGV >= 0 ? @ARGV : "1") {
     52   $THREADS = $arg;
     53   main();
     54 }
     55 
     56 
     57 #---------------------------------------------------------------------
     58 # ...
     59 sub main {
     60     my $date = localtime;
     61     my $threads = ($THREADS > 1) ? "($THREADS threads)" : "";
     62     my $title = "ICU4J Performance Test $threads $date";
     63 
     64     my $html = $date;
     65     $html =~ s/://g; # ':' illegal
     66     $html =~ s/\s*\d+$//; # delete year
     67     $html =~ s/^\w+\s*//; # delete dow
     68     $html = "perf $html.html";
     69 
     70     open(HTML,">$html") or die "Can't write to $html: $!";
     71 
     72     print HTML <<EOF;
     73 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
     74    "http://www.w3.org/TR/html4/strict.dtd">
     75 <HTML>
     76    <HEAD>
     77       <TITLE>$title</TITLE>
     78    </HEAD>
     79    <BODY>
     80 EOF
     81     print HTML "<H1>$title</H1>\n";
     82 
     83     print HTML "<H2>$TESTCLASS</H2>\n";
     84 
     85     my $raw = "";
     86 
     87     for my $methodPair (@METHODS) {
     88 
     89         my $testMethod = $methodPair->[0];
     90         my $baselineMethod = $methodPair->[1];
     91 
     92         print HTML "<P><TABLE $TABLEATTR><TR><TD>\n";
     93         print HTML "<P><B>$testMethod vs. $baselineMethod</B></P>\n";
     94         
     95         print HTML "<P><TABLE $TABLEATTR BGCOLOR=\"#CCFFFF\">\n";
     96         print HTML "<TR><TD>Options</TD><TD>$testMethod</TD>";
     97         print HTML "<TD>$baselineMethod</TD><TD>Ratio</TD></TR>\n";
     98         $OUT = '';
     99 
    100         for my $pat (@OPTIONS) {
    101             print HTML "<TR><TD>@$pat[0], \"@$pat[1]\", \"@$pat[2]\"</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 "\n$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 for input file @$pat[0] for encoding @$pat[2] , ");
    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
    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 -classpath classes $TESTCLASS $method $n -p $passes -L @$pat[0] \"@$pat[1]\" \"@$pat[2]\" -r $THREADS";
    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
    494