lib/Benchmark.pm

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