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