This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Regen Configure, all of xs_apiversion didn't take.
[perl5.git] / lib / Benchmark.pm
CommitLineData
a0d0e21e
LW
1package Benchmark;
2
f06db76b
AD
3=head1 NAME
4
5Benchmark - benchmark running times of code
6
7timethis - run a chunk of code several times
8
9timethese - run several chunks of code several times
10
431d98c2
BS
11cmpthese - print results of timethese as a comparison chart
12
f06db76b
AD
13timeit - run a chunk of code and see how long it goes
14
431d98c2
BS
15countit - see how many times a chunk of code runs in a given time
16
f06db76b
AD
17=head1 SYNOPSIS
18
19 timethis ($count, "code");
20
523cc92b 21 # Use Perl code in strings...
f06db76b
AD
22 timethese($count, {
23 'Name1' => '...code1...',
24 'Name2' => '...code2...',
25 });
26
523cc92b
CS
27 # ... or use subroutine references.
28 timethese($count, {
29 'Name1' => sub { ...code1... },
30 'Name2' => sub { ...code2... },
31 });
32
431d98c2
BS
33 # cmpthese can be used both ways as well
34 cmpthese($count, {
35 'Name1' => '...code1...',
36 'Name2' => '...code2...',
37 });
38
39 cmpthese($count, {
40 'Name1' => sub { ...code1... },
41 'Name2' => sub { ...code2... },
42 });
43
44 # ...or in two stages
45 $results = timethese($count,
46 {
47 'Name1' => sub { ...code1... },
48 'Name2' => sub { ...code2... },
49 },
50 'none'
51 );
52 cmpthese( $results ) ;
53
f06db76b
AD
54 $t = timeit($count, '...other code...')
55 print "$count loops of other code took:",timestr($t),"\n";
56
431d98c2
BS
57 $t = countit($time, '...other code...')
58 $count = $t->iters ;
59 print "$count loops of other code took:",timestr($t),"\n";
60
f06db76b
AD
61=head1 DESCRIPTION
62
63The Benchmark module encapsulates a number of routines to help you
64figure out how long it takes to execute some code.
65
66=head2 Methods
67
68=over 10
69
70=item new
71
72Returns the current time. Example:
73
74 use Benchmark;
75 $t0 = new Benchmark;
76 # ... your code here ...
77 $t1 = new Benchmark;
78 $td = timediff($t1, $t0);
a24a9dfe 79 print "the code took:",timestr($td),"\n";
f06db76b
AD
80
81=item debug
82
83Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
84
523cc92b 85 debug Benchmark 1;
f06db76b 86 $t = timeit(10, ' 5 ** $Global ');
523cc92b 87 debug Benchmark 0;
f06db76b 88
431d98c2
BS
89=item iters
90
91Returns the number of iterations.
92
f06db76b
AD
93=back
94
95=head2 Standard Exports
96
523cc92b 97The following routines will be exported into your namespace
f06db76b
AD
98if you use the Benchmark module:
99
100=over 10
101
431d98c2
BS
102=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
103
104=item cmpthese ( RESULTSHASHREF )
105
106Optionally calls timethese(), then outputs comparison chart. This
107chart is sorted from slowest to highest, and shows the percent
108speed difference between each pair of tests. Can also be passed
109the data structure that timethese() returns:
110
111 $results = timethese( .... );
112 cmpthese( $results );
113
114Returns the data structure returned by timethese().
115
116=item countit(TIME, CODE)
117
118Arguments: TIME is the minimum length of time to run CODE for, and CODE is
119the code to run. CODE may be either a code reference or a string to
120be eval'd; either way it will be run in the caller's package.
121
122TIME is I<not> negative. countit() will run the loop many times to
123calculate the speed of CODE before running it for TIME. The actual
124time run for will usually be greater than TIME due to system clock
125resolution, so it's best to look at the number of iterations divided
126by the times that you are concerned with, not just the iterations.
127
128Returns: a Benchmark object.
129
f06db76b
AD
130=item timeit(COUNT, CODE)
131
523cc92b
CS
132Arguments: COUNT is the number of times to run the loop, and CODE is
133the code to run. CODE may be either a code reference or a string to
134be eval'd; either way it will be run in the caller's package.
135
136Returns: a Benchmark object.
137
138=item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
139
140Time COUNT iterations of CODE. CODE may be a string to eval or a
141code reference; either way the CODE will run in the caller's package.
142Results will be printed to STDOUT as TITLE followed by the times.
143TITLE defaults to "timethis COUNT" if none is provided. STYLE
144determines the format of the output, as described for timestr() below.
145
6ee623d5
GS
146The COUNT can be zero or negative: this means the I<minimum number of
147CPU seconds> to run. A zero signifies the default of 3 seconds. For
148example to run at least for 10 seconds:
149
150 timethis(-10, $code)
151
152or to run two pieces of code tests for at least 3 seconds:
153
154 timethese(0, { test1 => '...', test2 => '...'})
155
156CPU seconds is, in UNIX terms, the user time plus the system time of
157the process itself, as opposed to the real (wallclock) time and the
158time spent by the child processes. Less than 0.1 seconds is not
159accepted (-0.01 as the count, for example, will cause a fatal runtime
160exception).
161
162Note that the CPU seconds is the B<minimum> time: CPU scheduling and
163other operating system factors may complicate the attempt so that a
164little bit more time is spent. The benchmark output will, however,
165also tell the number of C<$code> runs/second, which should be a more
166interesting number than the actually spent seconds.
167
168Returns a Benchmark object.
169
523cc92b 170=item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
f06db76b 171
523cc92b
CS
172The CODEHASHREF is a reference to a hash containing names as keys
173and either a string to eval or a code reference for each value.
174For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
175call
f06db76b 176
523cc92b 177 timethis(COUNT, VALUE, KEY, STYLE)
f06db76b 178
1d2dff63
GS
179The routines are called in string comparison order of KEY.
180
181The COUNT can be zero or negative, see timethis().
6ee623d5 182
3c6312e9
BS
183Returns a hash of Benchmark objects, keyed by name.
184
523cc92b 185=item timediff ( T1, T2 )
f06db76b 186
523cc92b
CS
187Returns the difference between two Benchmark times as a Benchmark
188object suitable for passing to timestr().
f06db76b 189
705cc255
TB
190=item timesum ( T1, T2 )
191
192Returns the sum of two Benchmark times as a Benchmark object suitable
193for passing to timestr().
194
6ee623d5 195=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
f06db76b 196
523cc92b
CS
197Returns a string that formats the times in the TIMEDIFF object in
198the requested STYLE. TIMEDIFF is expected to be a Benchmark object
199similar to that returned by timediff().
200
3c6312e9
BS
201STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
202each of the 5 times available ('wallclock' time, user time, system time,
523cc92b
CS
203user time of children, and system time of children). 'noc' shows all
204except the two children times. 'nop' shows only wallclock and the
205two children times. 'auto' (the default) will act as 'all' unless
206the children times are both zero, in which case it acts as 'noc'.
3c6312e9 207'none' prevents output.
523cc92b
CS
208
209FORMAT is the L<printf(3)>-style format specifier (without the
210leading '%') to use to print the times. It defaults to '5.2f'.
f06db76b
AD
211
212=back
213
214=head2 Optional Exports
215
216The following routines will be exported into your namespace
217if you specifically ask that they be imported:
218
219=over 10
220
523cc92b
CS
221=item clearcache ( COUNT )
222
223Clear the cached time for COUNT rounds of the null loop.
224
225=item clearallcache ( )
f06db76b 226
523cc92b 227Clear all cached times.
f06db76b 228
523cc92b 229=item disablecache ( )
f06db76b 230
523cc92b
CS
231Disable caching of timings for the null loop. This will force Benchmark
232to recalculate these timings for each new piece of code timed.
233
234=item enablecache ( )
235
236Enable caching of timings for the null loop. The time taken for COUNT
237rounds of the null loop will be calculated only once for each
238different COUNT used.
f06db76b
AD
239
240=back
241
242=head1 NOTES
243
244The data is stored as a list of values from the time and times
523cc92b 245functions:
f06db76b 246
431d98c2 247 ($real, $user, $system, $children_user, $children_system, $iters)
f06db76b
AD
248
249in seconds for the whole loop (not divided by the number of rounds).
250
251The timing is done using time(3) and times(3).
252
253Code is executed in the caller's package.
254
f06db76b
AD
255The time of the null loop (a loop with the same
256number of rounds but empty loop body) is subtracted
257from the time of the real loop.
258
3c6312e9 259The null loop times can be cached, the key being the
f06db76b
AD
260number of rounds. The caching can be controlled using
261calls like these:
262
523cc92b 263 clearcache($key);
f06db76b
AD
264 clearallcache();
265
523cc92b 266 disablecache();
f06db76b
AD
267 enablecache();
268
3c6312e9
BS
269Caching is off by default, as it can (usually slightly) decrease
270accuracy and does not usually noticably affect runtimes.
271
f06db76b
AD
272=head1 INHERITANCE
273
274Benchmark inherits from no other class, except of course
275for Exporter.
276
277=head1 CAVEATS
278
80eab818 279Comparing eval'd strings with code references will give you
431d98c2 280inaccurate results: a code reference will show a slightly slower
80eab818
CS
281execution time than the equivalent eval'd string.
282
f06db76b
AD
283The real time timing is done using time(2) and
284the granularity is therefore only one second.
285
286Short tests may produce negative figures because perl
523cc92b
CS
287can appear to take longer to execute the empty loop
288than a short test; try:
f06db76b
AD
289
290 timethis(100,'1');
291
292The system time of the null loop might be slightly
293more than the system time of the loop with the actual
a24a9dfe 294code and therefore the difference might end up being E<lt> 0.
f06db76b 295
f06db76b
AD
296=head1 AUTHORS
297
5aabfad6 298Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
f06db76b
AD
299
300=head1 MODIFICATION HISTORY
301
302September 8th, 1994; by Tim Bunce.
303
523cc92b
CS
304March 28th, 1997; by Hugo van der Sanden: added support for code
305references and the already documented 'debug' method; revamped
306documentation.
f06db76b 307
6ee623d5
GS
308April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
309functionality.
310
3c6312e9
BS
311September, 1999; by Barrie Slaymaker: math fixes and accuracy and
312efficiency tweaks. Added cmpthese(). A result is now returned from
431d98c2 313timethese(). Exposed countit() (was runfor()).
3c6312e9 314
523cc92b 315=cut
a0d0e21e 316
3f943bd9
GS
317# evaluate something in a clean lexical environment
318sub _doeval { eval shift }
319
320#
321# put any lexicals at file scope AFTER here
322#
323
4aa0a1f7 324use Carp;
a0d0e21e
LW
325use Exporter;
326@ISA=(Exporter);
431d98c2
BS
327@EXPORT=qw(cmpthese countit timeit timethis timethese timediff timestr);
328@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
a0d0e21e
LW
329
330&init;
331
332sub init {
333 $debug = 0;
334 $min_count = 4;
335 $min_cpu = 0.4;
336 $defaultfmt = '5.2f';
337 $defaultstyle = 'auto';
338 # The cache can cause a slight loss of sys time accuracy. If a
339 # user does many tests (>10) with *very* large counts (>10000)
340 # or works on a very slow machine the cache may be useful.
341 &disablecache;
342 &clearallcache;
343}
344
523cc92b
CS
345sub debug { $debug = ($_[1] != 0); }
346
bba8fca5
BS
347# The cache needs two branches: 's' for strings and 'c' for code. The
348# emtpy loop is different in these two cases.
349sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
a0d0e21e
LW
350sub clearallcache { %cache = (); }
351sub enablecache { $cache = 1; }
352sub disablecache { $cache = 0; }
353
a0d0e21e
LW
354# --- Functions to process the 'time' data type
355
6ee623d5
GS
356sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
357 print "new=@t\n" if $debug;
358 bless \@t; }
a0d0e21e
LW
359
360sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
361sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
362sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
363sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
431d98c2 364sub iters { $_[0]->[5] ; }
a0d0e21e 365
523cc92b 366sub timediff {
a0d0e21e 367 my($a, $b) = @_;
523cc92b 368 my @r;
3f943bd9 369 for (my $i=0; $i < @$a; ++$i) {
a0d0e21e
LW
370 push(@r, $a->[$i] - $b->[$i]);
371 }
372 bless \@r;
373}
374
705cc255
TB
375sub timesum {
376 my($a, $b) = @_;
377 my @r;
378 for (my $i=0; $i < @$a; ++$i) {
379 push(@r, $a->[$i] + $b->[$i]);
380 }
381 bless \@r;
382}
383
523cc92b 384sub timestr {
a0d0e21e 385 my($tr, $style, $f) = @_;
523cc92b 386 my @t = @$tr;
6ee623d5
GS
387 warn "bad time value (@t)" unless @t==6;
388 my($r, $pu, $ps, $cu, $cs, $n) = @t;
a0d0e21e 389 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
523cc92b 390 $f = $defaultfmt unless defined $f;
a0d0e21e 391 # format a time in the required style, other formats may be added here
80eab818 392 $style ||= $defaultstyle;
523cc92b
CS
393 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
394 my $s = "@t $style"; # default for unknown style
7be077a2 395 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
523cc92b 396 @t,$t) if $style eq 'all';
7be077a2
GS
397 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
398 $r,$pu,$ps,$pt) if $style eq 'noc';
399 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
400 $r,$cu,$cs,$ct) if $style eq 'nop';
6ee623d5 401 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
a0d0e21e
LW
402 $s;
403}
523cc92b
CS
404
405sub timedebug {
a0d0e21e 406 my($msg, $t) = @_;
523cc92b 407 print STDERR "$msg",timestr($t),"\n" if $debug;
a0d0e21e
LW
408}
409
a0d0e21e
LW
410# --- Functions implementing low-level support for timing loops
411
412sub runloop {
413 my($n, $c) = @_;
4aa0a1f7
AD
414
415 $n+=0; # force numeric now, so garbage won't creep into the eval
523cc92b
CS
416 croak "negative loopcount $n" if $n<0;
417 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
a0d0e21e
LW
418 my($t0, $t1, $td); # before, after, difference
419
420 # find package of caller so we can execute code there
523cc92b
CS
421 my($curpack) = caller(0);
422 my($i, $pack)= 0;
a0d0e21e
LW
423 while (($pack) = caller(++$i)) {
424 last if $pack ne $curpack;
425 }
426
3f943bd9
GS
427 my ($subcode, $subref);
428 if (ref $c eq 'CODE') {
429 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
430 $subref = eval $subcode;
431 }
432 else {
433 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
434 $subref = _doeval($subcode);
435 }
4aa0a1f7 436 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
523cc92b 437 print STDERR "runloop $n '$subcode'\n" if $debug;
a0d0e21e 438
3c6312e9
BS
439 # Wait for the user timer to tick. This makes the error range more like
440 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
441 # may not seem important, but it significantly reduces the chances of
442 # getting a too low initial $n in the initial, 'find the minimum' loop
431d98c2 443 # in &countit. This, in turn, can reduce the number of calls to
bba8fca5
BS
444 # &runloop a lot, and thus reduce additive errors.
445 my $tbase = Benchmark->new(0)->[1];
446 do {
447 $t0 = Benchmark->new(0);
3c6312e9 448 } while ( $t0->[1] == $tbase );
a0d0e21e 449 &$subref;
6ee623d5 450 $t1 = Benchmark->new($n);
a0d0e21e 451 $td = &timediff($t1, $t0);
a0d0e21e
LW
452 timedebug("runloop:",$td);
453 $td;
454}
455
456
457sub timeit {
458 my($n, $code) = @_;
459 my($wn, $wc, $wd);
460
461 printf STDERR "timeit $n $code\n" if $debug;
3c6312e9 462 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
bba8fca5
BS
463 if ($cache && exists $cache{$cache_key} ) {
464 $wn = $cache{$cache_key};
523cc92b 465 } else {
bba8fca5 466 $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
3c6312e9
BS
467 # Can't let our baseline have any iterations, or they get subtracted
468 # out of the result.
469 $wn->[5] = 0;
bba8fca5 470 $cache{$cache_key} = $wn;
a0d0e21e
LW
471 }
472
473 $wc = &runloop($n, $code);
474
475 $wd = timediff($wc, $wn);
a0d0e21e
LW
476 timedebug("timeit: ",$wc);
477 timedebug(" - ",$wn);
478 timedebug(" = ",$wd);
479
480 $wd;
481}
482
6ee623d5
GS
483
484my $default_for = 3;
485my $min_for = 0.1;
486
3c6312e9 487
431d98c2
BS
488sub countit {
489 my ( $tmax, $code ) = @_;
6ee623d5
GS
490
491 if ( not defined $tmax or $tmax == 0 ) {
492 $tmax = $default_for;
493 } elsif ( $tmax < 0 ) {
494 $tmax = -$tmax;
495 }
496
431d98c2 497 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
6ee623d5
GS
498 if $tmax < $min_for;
499
3c6312e9 500 my ($n, $tc);
6ee623d5 501
bba8fca5 502 # First find the minimum $n that gives a significant timing.
3c6312e9
BS
503 for ($n = 1; ; $n *= 2 ) {
504 my $td = timeit($n, $code);
505 $tc = $td->[1] + $td->[2];
506 last if $tc > 0.1;
507 }
6ee623d5 508
3c6312e9
BS
509 my $nmin = $n;
510
511 # Get $n high enough that we can guess the final $n with some accuracy.
512 my $tpra = 0.1 * $tmax; # Target/time practice.
513 while ( $tc < $tpra ) {
514 # The 5% fudge is to keep us from iterating again all
515 # that often (this speeds overall responsiveness when $tmax is big
516 # and we guess a little low). This does not noticably affect
517 # accuracy since we're not couting these times.
518 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
519 my $td = timeit($n, $code);
6ee623d5
GS
520 $tc = $td->[1] + $td->[2];
521 }
522
3c6312e9
BS
523 # Now, do the 'for real' timing(s), repeating until we exceed
524 # the max.
525 my $ntot = 0;
526 my $rtot = 0;
527 my $utot = 0.0;
528 my $stot = 0.0;
529 my $cutot = 0.0;
530 my $cstot = 0.0;
531 my $ttot = 0.0;
532
533 # The 5% fudge is because $n is often a few % low even for routines
534 # with stable times and avoiding extra timeit()s is nice for
535 # accuracy's sake.
536 $n = int( $n * ( 1.05 * $tmax / $tc ) );
537
538 while () {
539 my $td = timeit($n, $code);
540 $ntot += $n;
541 $rtot += $td->[0];
542 $utot += $td->[1];
543 $stot += $td->[2];
6ee623d5
GS
544 $cutot += $td->[3];
545 $cstot += $td->[4];
3c6312e9
BS
546 $ttot = $utot + $stot;
547 last if $ttot >= $tmax;
6ee623d5 548
3c6312e9 549 my $r = $tmax / $ttot - 1; # Linear approximation.
bba8fca5 550 $n = int( $r * $ntot );
6ee623d5 551 $n = $nmin if $n < $nmin;
6ee623d5
GS
552 }
553
554 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
555}
556
a0d0e21e
LW
557# --- Functions implementing high-level time-then-print utilities
558
6ee623d5
GS
559sub n_to_for {
560 my $n = shift;
561 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
562}
563
a0d0e21e
LW
564sub timethis{
565 my($n, $code, $title, $style) = @_;
6ee623d5
GS
566 my($t, $for, $forn);
567
568 if ( $n > 0 ) {
569 croak "non-integer loopcount $n, stopped" if int($n)<$n;
570 $t = timeit($n, $code);
571 $title = "timethis $n" unless defined $title;
572 } else {
573 $fort = n_to_for( $n );
431d98c2 574 $t = countit( $fort, $code );
6ee623d5
GS
575 $title = "timethis for $fort" unless defined $title;
576 $forn = $t->[-1];
577 }
523cc92b 578 local $| = 1;
523cc92b 579 $style = "" unless defined $style;
3c6312e9
BS
580 printf("%10s: ", $title) unless $style eq 'none';
581 print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
6ee623d5
GS
582
583 $n = $forn if defined $forn;
523cc92b 584
a0d0e21e
LW
585 # A conservative warning to spot very silly tests.
586 # Don't assume that your benchmark is ok simply because
587 # you don't get this warning!
588 print " (warning: too few iterations for a reliable count)\n"
523cc92b 589 if $n < $min_count
a0d0e21e 590 || ($t->real < 1 && $n < 1000)
523cc92b 591 || $t->cpu_a < $min_cpu;
a0d0e21e
LW
592 $t;
593}
594
a0d0e21e
LW
595sub timethese{
596 my($n, $alt, $style) = @_;
597 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
598 unless ref $alt eq HASH;
523cc92b
CS
599 my @names = sort keys %$alt;
600 $style = "" unless defined $style;
3c6312e9 601 print "Benchmark: " unless $style eq 'none';
6ee623d5
GS
602 if ( $n > 0 ) {
603 croak "non-integer loopcount $n, stopped" if int($n)<$n;
3c6312e9 604 print "timing $n iterations of" unless $style eq 'none';
6ee623d5 605 } else {
3c6312e9 606 print "running" unless $style eq 'none';
6ee623d5 607 }
3c6312e9 608 print " ", join(', ',@names) unless $style eq 'none';
6ee623d5
GS
609 unless ( $n > 0 ) {
610 my $for = n_to_for( $n );
3c6312e9 611 print ", each for at least $for CPU seconds" unless $style eq 'none';
6ee623d5 612 }
3c6312e9 613 print "...\n" unless $style eq 'none';
523cc92b
CS
614
615 # we could save the results in an array and produce a summary here
a0d0e21e 616 # sum, min, max, avg etc etc
3c6312e9 617 my %results;
4dbb2df9 618 foreach my $name (@names) {
3c6312e9 619 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
4dbb2df9 620 }
3c6312e9
BS
621
622 return \%results;
a0d0e21e
LW
623}
624
3c6312e9
BS
625sub cmpthese{
626 my $results = ref $_[0] ? $_[0] : timethese( @_ );
627
628 return $results
629 if defined $_[2] && $_[2] eq 'none';
630
631 # Flatten in to an array of arrays with the name as the first field
632 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
633
634 for (@vals) {
635 # The epsilon fudge here is to prevent div by 0. Since clock
636 # resolutions are much larger, it's below the noise floor.
637 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
638 $_->[7] = $rate;
639 }
640
641 # Sort by rate
642 @vals = sort { $a->[7] <=> $b->[7] } @vals;
643
644 # If more than half of the rates are greater than one...
645 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
646
647 my @rows;
648 my @col_widths;
649
650 my @top_row = (
651 '',
652 $display_as_rate ? 'Rate' : 's/iter',
653 map { $_->[0] } @vals
654 );
655
656 push @rows, \@top_row;
657 @col_widths = map { length( $_ ) } @top_row;
658
659 # Build the data rows
660 # We leave the last column in even though it never has any data. Perhaps
661 # it should go away. Also, perhaps a style for a single column of
662 # percentages might be nice.
663 for my $row_val ( @vals ) {
664 my @row;
665
666 # Column 0 = test name
667 push @row, $row_val->[0];
668 $col_widths[0] = length( $row_val->[0] )
669 if length( $row_val->[0] ) > $col_widths[0];
670
671 # Column 1 = performance
672 my $row_rate = $row_val->[7];
673
674 # We assume that we'll never get a 0 rate.
675 my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
676
677 # Only give a few decimal places before switching to sci. notation,
678 # since the results aren't usually that accurate anyway.
679 my $format =
680 $a >= 100 ?
681 "%0.0f" :
682 $a >= 10 ?
683 "%0.1f" :
684 $a >= 1 ?
685 "%0.2f" :
686 $a >= 0.1 ?
687 "%0.3f" :
688 "%0.2e";
689
690 $format .= "/s"
691 if $display_as_rate;
692 # Using $b here due to optimizing bug in _58 through _61
693 my $b = sprintf( $format, $a );
694 push @row, $b;
695 $col_widths[1] = length( $b )
696 if length( $b ) > $col_widths[1];
697
698 # Columns 2..N = performance ratios
699 my $skip_rest = 0;
700 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
701 my $col_val = $vals[$col_num];
702 my $out;
703 if ( $skip_rest ) {
704 $out = '';
705 }
706 elsif ( $col_val->[0] eq $row_val->[0] ) {
707 $out = "--";
708 # $skip_rest = 1;
709 }
710 else {
711 my $col_rate = $col_val->[7];
712 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
713 }
714 push @row, $out;
715 $col_widths[$col_num+2] = length( $out )
716 if length( $out ) > $col_widths[$col_num+2];
717
718 # A little wierdness to set the first column width properly
719 $col_widths[$col_num+2] = length( $col_val->[0] )
720 if length( $col_val->[0] ) > $col_widths[$col_num+2];
721 }
722 push @rows, \@row;
723 }
724
725 # Equalize column widths in the chart as much as possible without
726 # exceeding 80 characters. This does not use or affect cols 0 or 1.
727 my @sorted_width_refs =
728 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
729 my $max_width = ${$sorted_width_refs[-1]};
730
731 my $total = 0;
732 for ( @col_widths ) { $total += $_ }
733
734 STRETCHER:
735 while ( $total < 80 ) {
736 my $min_width = ${$sorted_width_refs[0]};
737 last
738 if $min_width == $max_width;
739 for ( @sorted_width_refs ) {
740 last
741 if $$_ > $min_width;
742 ++$$_;
743 ++$total;
744 last STRETCHER
745 if $total >= 80;
746 }
747 }
748
749 # Dump the output
750 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
751 substr( $format, 1, 0 ) = '-';
752 for ( @rows ) {
753 printf $format, @$_;
754 }
755
756 return $results;
757}
758
759
a0d0e21e 7601;