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 qw( cmpthese ) ;
 309     $x = 3;
 310     cmpthese( -5, {
 311         a => sub{$x*$x},
 312         b => sub{$x**2},
 313     } );
 314
 315 outputs something like this:
 316
 317    Benchmark: running a, b, each for at least 5 CPU seconds...
 318           Rate    b    a
 319    b 1559428/s   -- -62%
 320    a 4152037/s 166%   --
 321
 322
 323 while
 324
 325     use Benchmark qw( timethese cmpthese ) ;
 326     $x = 3;
 327     $r = timethese( -5, {
 328         a => sub{$x*$x},
 329         b => sub{$x**2},
 330     } );
 331     cmpthese $r;
 332
 333 outputs something like this:
 334
 335     Benchmark: running a, b, each for at least 5 CPU seconds...
 336              a: 10 wallclock secs ( 5.14 usr +  0.13 sys =  5.27 CPU) @ 3835055.60/s (n=20210743)
 337              b:  5 wallclock secs ( 5.41 usr +  0.00 sys =  5.41 CPU) @ 1574944.92/s (n=8520452)
 338            Rate    b    a
 339     b 1574945/s   -- -59%
 340     a 3835056/s 144%   --
 341
 342
 343 =head1 INHERITANCE
 344
 345 Benchmark inherits from no other class, except of course
 346 for Exporter.
 347
 348 =head1 CAVEATS
 349
 350 Comparing eval'd strings with code references will give you
 351 inaccurate results: a code reference will show a slightly slower
 352 execution time than the equivalent eval'd string.
 353
 354 The real time timing is done using time(2) and
 355 the granularity is therefore only one second.
 356
 357 Short tests may produce negative figures because perl
 358 can appear to take longer to execute the empty loop
 359 than a short test; try:
 360
 361     timethis(100,'1');
 362
 363 The system time of the null loop might be slightly
 364 more than the system time of the loop with the actual
 365 code and therefore the difference might end up being E<lt> 0.
 366
 367 =head1 SEE ALSO
 368
 369 L<Devel::DProf> - a Perl code profiler
 370
 371 =head1 AUTHORS
 372
 373 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 374
 375 =head1 MODIFICATION HISTORY
 376
 377 September 8th, 1994; by Tim Bunce.
 378
 379 March 28th, 1997; by Hugo van der Sanden: added support for code
 380 references and the already documented 'debug' method; revamped
 381 documentation.
 382
 383 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 384 functionality.
 385
 386 September, 1999; by Barrie Slaymaker: math fixes and accuracy and
 387 efficiency tweaks.  Added cmpthese().  A result is now returned from
 388 timethese().  Exposed countit() (was runfor()).
 389
 390 =cut
 391
 392 # evaluate something in a clean lexical environment
 393 sub _doeval { eval shift }
 394
 395 #
 396 # put any lexicals at file scope AFTER here
 397 #
 398
 399 use Carp;
 400 use Exporter;
 401 @ISA=(Exporter);
 402 @EXPORT=qw(timeit timethis timethese timediff timestr);
 403 @EXPORT_OK=qw(timesum cmpthese countit
 404               clearcache clearallcache disablecache enablecache);
 405
 406 $VERSION = 1.01;
 407
 408 &init;
 409
 410 sub init {
 411     $debug = 0;
 412     $min_count = 4;
 413     $min_cpu   = 0.4;
 414     $defaultfmt = '5.2f';
 415     $defaultstyle = 'auto';
 416     # The cache can cause a slight loss of sys time accuracy. If a
 417     # user does many tests (>10) with *very* large counts (>10000)
 418     # or works on a very slow machine the cache may be useful.
 419     &disablecache;
 420     &clearallcache;
 421 }
 422
 423 sub debug { $debug = ($_[1] != 0); }
 424
 425 # The cache needs two branches: 's' for strings and 'c' for code.  The
 426 # emtpy loop is different in these two cases.
 427 sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
 428 sub clearallcache { %cache = (); }
 429 sub enablecache   { $cache = 1; }
 430 sub disablecache  { $cache = 0; }
 431
 432 # --- Functions to process the 'time' data type
 433
 434 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
 435           print "new=@t\n" if $debug;
 436           bless \@t; }
 437
 438 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 439 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 440 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 441 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 442 sub iters { $_[0]->[5] ; }
 443
 444 sub timediff {
 445     my($a, $b) = @_;
 446     my @r;
 447     for (my $i=0; $i < @$a; ++$i) {
 448         push(@r, $a->[$i] - $b->[$i]);
 449     }
 450     bless \@r;
 451 }
 452
 453 sub timesum {
 454      my($a, $b) = @_;
 455      my @r;
 456      for (my $i=0; $i < @$a; ++$i) {
 457         push(@r, $a->[$i] + $b->[$i]);
 458      }
 459      bless \@r;
 460 }
 461
 462 sub timestr {
 463     my($tr, $style, $f) = @_;
 464     my @t = @$tr;
 465     warn "bad time value (@t)" unless @t==6;
 466     my($r, $pu, $ps, $cu, $cs, $n) = @t;
 467     my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 468     $f = $defaultfmt unless defined $f;
 469     # format a time in the required style, other formats may be added here
 470     $style ||= $defaultstyle;
 471     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 472     my $s = "@t $style"; # default for unknown style
 473     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
 474                             $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
 475     $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
 476                             $r,$pu,$ps,$pt) if $style eq 'noc';
 477     $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
 478                             $r,$cu,$cs,$ct) if $style eq 'nop';
 479     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
 480     $s;
 481 }
 482
 483 sub timedebug {
 484     my($msg, $t) = @_;
 485     print STDERR "$msg",timestr($t),"\n" if $debug;
 486 }
 487
 488 # --- Functions implementing low-level support for timing loops
 489
 490 sub runloop {
 491     my($n, $c) = @_;
 492
 493     $n+=0; # force numeric now, so garbage won't creep into the eval
 494     croak "negative loopcount $n" if $n<0;
 495     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 496     my($t0, $t1, $td); # before, after, difference
 497
 498     # find package of caller so we can execute code there
 499     my($curpack) = caller(0);
 500     my($i, $pack)= 0;
 501     while (($pack) = caller(++$i)) {
 502         last if $pack ne $curpack;
 503     }
 504
 505     my ($subcode, $subref);
 506     if (ref $c eq 'CODE') {
 507         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
 508         $subref  = eval $subcode;
 509     }
 510     else {
 511         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
 512         $subref  = _doeval($subcode);
 513     }
 514     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 515     print STDERR "runloop $n '$subcode'\n" if $debug;
 516
 517     # Wait for the user timer to tick.  This makes the error range more like
 518     # -0.01, +0.  If we don't wait, then it's more like -0.01, +0.01.  This
 519     # may not seem important, but it significantly reduces the chances of
 520     # getting a too low initial $n in the initial, 'find the minimum' loop
 521     # in &countit.  This, in turn, can reduce the number of calls to
 522     # &runloop a lot, and thus reduce additive errors.
 523     my $tbase = Benchmark->new(0)->[1];
 524     while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
 525     &$subref;
 526     $t1 = Benchmark->new($n);
 527     $td = &timediff($t1, $t0);
 528     timedebug("runloop:",$td);
 529     $td;
 530 }
 531
 532
 533 sub timeit {
 534     my($n, $code) = @_;
 535     my($wn, $wc, $wd);
 536
 537     printf STDERR "timeit $n $code\n" if $debug;
 538     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
 539     if ($cache && exists $cache{$cache_key} ) {
 540         $wn = $cache{$cache_key};
 541     } else {
 542         $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
 543         # Can't let our baseline have any iterations, or they get subtracted
 544         # out of the result.
 545         $wn->[5] = 0;
 546         $cache{$cache_key} = $wn;
 547     }
 548
 549     $wc = &runloop($n, $code);
 550
 551     $wd = timediff($wc, $wn);
 552     timedebug("timeit: ",$wc);
 553     timedebug("      - ",$wn);
 554     timedebug("      = ",$wd);
 555
 556     $wd;
 557 }
 558
 559
 560 my $default_for = 3;
 561 my $min_for     = 0.1;
 562
 563
 564 sub countit {
 565     my ( $tmax, $code ) = @_;
 566
 567     if ( not defined $tmax or $tmax == 0 ) {
 568         $tmax = $default_for;
 569     } elsif ( $tmax < 0 ) {
 570         $tmax = -$tmax;
 571     }
 572
 573     die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
 574         if $tmax < $min_for;
 575
 576     my ($n, $tc);
 577
 578     # First find the minimum $n that gives a significant timing.
 579     for ($n = 1; ; $n *= 2 ) {
 580         my $td = timeit($n, $code);
 581         $tc = $td->[1] + $td->[2];
 582         last if $tc > 0.1;
 583     }
 584
 585     my $nmin = $n;
 586
 587     # Get $n high enough that we can guess the final $n with some accuracy.
 588     my $tpra = 0.1 * $tmax; # Target/time practice.
 589     while ( $tc < $tpra ) {
 590         # The 5% fudge is to keep us from iterating again all
 591         # that often (this speeds overall responsiveness when $tmax is big
 592         # and we guess a little low).  This does not noticably affect
 593         # accuracy since we're not couting these times.
 594         $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
 595         my $td = timeit($n, $code);
 596         my $new_tc = $td->[1] + $td->[2];
 597         # Make sure we are making progress.
 598         $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
 599     }
 600
 601     # Now, do the 'for real' timing(s), repeating until we exceed
 602     # the max.
 603     my $ntot  = 0;
 604     my $rtot  = 0;
 605     my $utot  = 0.0;
 606     my $stot  = 0.0;
 607     my $cutot = 0.0;
 608     my $cstot = 0.0;
 609     my $ttot  = 0.0;
 610
 611     # The 5% fudge is because $n is often a few % low even for routines
 612     # with stable times and avoiding extra timeit()s is nice for
 613     # accuracy's sake.
 614     $n = int( $n * ( 1.05 * $tmax / $tc ) );
 615
 616     while () {
 617         my $td = timeit($n, $code);
 618         $ntot  += $n;
 619         $rtot  += $td->[0];
 620         $utot  += $td->[1];
 621         $stot  += $td->[2];
 622         $cutot += $td->[3];
 623         $cstot += $td->[4];
 624         $ttot = $utot + $stot;
 625         last if $ttot >= $tmax;
 626
 627         $ttot = 0.01 if $ttot < 0.01;
 628         my $r = $tmax / $ttot - 1; # Linear approximation.
 629         $n = int( $r * $ntot );
 630         $n = $nmin if $n < $nmin;
 631     }
 632
 633     return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
 634 }
 635
 636 # --- Functions implementing high-level time-then-print utilities
 637
 638 sub n_to_for {
 639     my $n = shift;
 640     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 641 }
 642
 643 sub timethis{
 644     my($n, $code, $title, $style) = @_;
 645     my($t, $for, $forn);
 646
 647     if ( $n > 0 ) {
 648         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 649         $t = timeit($n, $code);
 650         $title = "timethis $n" unless defined $title;
 651     } else {
 652         $fort  = n_to_for( $n );
 653         $t     = countit( $fort, $code );
 654         $title = "timethis for $fort" unless defined $title;
 655         $forn  = $t->[-1];
 656     }
 657     local $| = 1;
 658     $style = "" unless defined $style;
 659     printf("%10s: ", $title) unless $style eq 'none';
 660     print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
 661
 662     $n = $forn if defined $forn;
 663
 664     # A conservative warning to spot very silly tests.
 665     # Don't assume that your benchmark is ok simply because
 666     # you don't get this warning!
 667     print "            (warning: too few iterations for a reliable count)\n"
 668         if     $n < $min_count
 669             || ($t->real < 1 && $n < 1000)
 670             || $t->cpu_a < $min_cpu;
 671     $t;
 672 }
 673
 674 sub timethese{
 675     my($n, $alt, $style) = @_;
 676     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 677                 unless ref $alt eq HASH;
 678     my @names = sort keys %$alt;
 679     $style = "" unless defined $style;
 680     print "Benchmark: " unless $style eq 'none';
 681     if ( $n > 0 ) {
 682         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 683         print "timing $n iterations of" unless $style eq 'none';
 684     } else {
 685         print "running" unless $style eq 'none';
 686     }
 687     print " ", join(', ',@names) unless $style eq 'none';
 688     unless ( $n > 0 ) {
 689         my $for = n_to_for( $n );
 690         print ", each for at least $for CPU seconds" unless $style eq 'none';
 691     }
 692     print "...\n" unless $style eq 'none';
 693
 694     # we could save the results in an array and produce a summary here
 695     # sum, min, max, avg etc etc
 696     my %results;
 697     foreach my $name (@names) {
 698         $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
 699     }
 700
 701     return \%results;
 702 }
 703
 704 sub cmpthese{
 705     my ($results, $style) = ref $_[0] ? @_ : ( timethese( @_[0,1] ), $_[2] ) ;
 706
 707     $style = "" unless defined $style;
 708
 709     # Flatten in to an array of arrays with the name as the first field
 710     my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
 711
 712     for (@vals) {
 713         # The epsilon fudge here is to prevent div by 0.  Since clock
 714         # resolutions are much larger, it's below the noise floor.
 715         my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
 716         $_->[7] = $rate;
 717     }
 718
 719     # Sort by rate
 720     @vals = sort { $a->[7] <=> $b->[7] } @vals;
 721
 722     # If more than half of the rates are greater than one...
 723     my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
 724
 725     my @rows;
 726     my @col_widths;
 727
 728     my @top_row = (
 729         '',
 730         $display_as_rate ? 'Rate' : 's/iter',
 731         map { $_->[0] } @vals
 732     );
 733
 734     push @rows, \@top_row;
 735     @col_widths = map { length( $_ ) } @top_row;
 736
 737     # Build the data rows
 738     # We leave the last column in even though it never has any data.  Perhaps
 739     # it should go away.  Also, perhaps a style for a single column of
 740     # percentages might be nice.
 741     for my $row_val ( @vals ) {
 742         my @row;
 743
 744         # Column 0 = test name
 745         push @row, $row_val->[0];
 746         $col_widths[0] = length( $row_val->[0] )
 747             if length( $row_val->[0] ) > $col_widths[0];
 748
 749         # Column 1 = performance
 750         my $row_rate = $row_val->[7];
 751
 752         # We assume that we'll never get a 0 rate.
 753         my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
 754
 755         # Only give a few decimal places before switching to sci. notation,
 756         # since the results aren't usually that accurate anyway.
 757         my $format =
 758            $a >= 100 ?
 759                "%0.0f" :
 760            $a >= 10 ?
 761                "%0.1f" :
 762            $a >= 1 ?
 763                "%0.2f" :
 764            $a >= 0.1 ?
 765                "%0.3f" :
 766                "%0.2e";
 767
 768         $format .= "/s"
 769             if $display_as_rate;
 770         # Using $b here due to optimizing bug in _58 through _61
 771         my $b = sprintf( $format, $a );
 772         push @row, $b;
 773         $col_widths[1] = length( $b )
 774             if length( $b ) > $col_widths[1];
 775
 776         # Columns 2..N = performance ratios
 777         my $skip_rest = 0;
 778         for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
 779             my $col_val = $vals[$col_num];
 780             my $out;
 781             if ( $skip_rest ) {
 782                 $out = '';
 783             }
 784             elsif ( $col_val->[0] eq $row_val->[0] ) {
 785                 $out = "--";
 786                 # $skip_rest = 1;
 787             }
 788             else {
 789                 my $col_rate = $col_val->[7];
 790                 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
 791             }
 792             push @row, $out;
 793             $col_widths[$col_num+2] = length( $out )
 794                 if length( $out ) > $col_widths[$col_num+2];
 795
 796             # A little wierdness to set the first column width properly
 797             $col_widths[$col_num+2] = length( $col_val->[0] )
 798                 if length( $col_val->[0] ) > $col_widths[$col_num+2];
 799         }
 800         push @rows, \@row;
 801     }
 802
 803     return \@rows if $style eq "none";
 804
 805     # Equalize column widths in the chart as much as possible without
 806     # exceeding 80 characters.  This does not use or affect cols 0 or 1.
 807     my @sorted_width_refs =
 808        sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
 809     my $max_width = ${$sorted_width_refs[-1]};
 810
 811     my $total = @col_widths - 1 ;
 812     for ( @col_widths ) { $total += $_ }
 813
 814     STRETCHER:
 815     while ( $total < 80 ) {
 816         my $min_width = ${$sorted_width_refs[0]};
 817         last
 818            if $min_width == $max_width;
 819         for ( @sorted_width_refs ) {
 820             last
 821                 if $$_ > $min_width;
 822             ++$$_;
 823             ++$total;
 824             last STRETCHER
 825                 if $total >= 80;
 826         }
 827     }
 828
 829     # Dump the output
 830     my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
 831     substr( $format, 1, 0 ) = '-';
 832     for ( @rows ) {
 833         printf $format, @$_;
 834     }
 835
 836     return \@rows ;
 837 }
 838
 839
 840 1;