lib/Benchmark.pm

   1 package Benchmark;
   2
   3 =head1 NAME
   4
   5 Benchmark - benchmark running times of code
   6
   7 timethis - run a chunk of code several times
   8
   9 timethese - run several chunks of code several times
  10
  11 cmpthese - print results of timethese as a comparison chart
  12
  13 timeit - run a chunk of code and see how long it goes
  14
  15 countit - see how many times a chunk of code runs in a given time
  16
  17 =head1 SYNOPSIS
  18
  19     timethis ($count, "code");
  20
  21     # Use Perl code in strings...
  22     timethese($count, {
  23         'Name1' => '...code1...',
  24         'Name2' => '...code2...',
  25     });
  26
  27     # ... or use subroutine references.
  28     timethese($count, {
  29         'Name1' => sub { ...code1... },
  30         'Name2' => sub { ...code2... },
  31     });
  32
  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
  54     $t = timeit($count, '...other code...')
  55     print "$count loops of other code took:",timestr($t),"\n";
  56
  57     $t = countit($time, '...other code...')
  58     $count = $t->iters ;
  59     print "$count loops of other code took:",timestr($t),"\n";
  60
  61 =head1 DESCRIPTION
  62
  63 The Benchmark module encapsulates a number of routines to help you
  64 figure out how long it takes to execute some code.
  65
  66 =head2 Methods
  67
  68 =over 10
  69
  70 =item new
  71
  72 Returns 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);
  79     print "the code took:",timestr($td),"\n";
  80
  81 =item debug
  82
  83 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
  84
  85     debug Benchmark 1;
  86     $t = timeit(10, ' 5 ** $Global ');
  87     debug Benchmark 0;
  88
  89 =item iters
  90
  91 Returns the number of iterations.
  92
  93 =back
  94
  95 =head2 Standard Exports
  96
  97 The following routines will be exported into your namespace
  98 if you use the Benchmark module:
  99
 100 =over 10
 101
 102 =item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
 103
 104 =item cmpthese ( RESULTSHASHREF )
 105
 106 Optionally calls timethese(), then outputs comparison chart.  This
 107 chart is sorted from slowest to highest, and shows the percent
 108 speed difference between each pair of tests.  Can also be passed
 109 the data structure that timethese() returns:
 110
 111     $results = timethese( .... );
 112     cmpthese( $results );
 113
 114 Returns the data structure returned by timethese().
 115
 116 =item countit(TIME, CODE)
 117
 118 Arguments: TIME is the minimum length of time to run CODE for, and CODE is
 119 the code to run.  CODE may be either a code reference or a string to
 120 be eval'd; either way it will be run in the caller's package.
 121
 122 TIME is I<not> negative.  countit() will run the loop many times to
 123 calculate the speed of CODE before running it for TIME.  The actual
 124 time run for will usually be greater than TIME due to system clock
 125 resolution, so it's best to look at the number of iterations divided
 126 by the times that you are concerned with, not just the iterations.
 127
 128 Returns: a Benchmark object.
 129
 130 =item timeit(COUNT, CODE)
 131
 132 Arguments: COUNT is the number of times to run the loop, and CODE is
 133 the code to run.  CODE may be either a code reference or a string to
 134 be eval'd; either way it will be run in the caller's package.
 135
 136 Returns: a Benchmark object.
 137
 138 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
 139
 140 Time COUNT iterations of CODE. CODE may be a string to eval or a
 141 code reference; either way the CODE will run in the caller's package.
 142 Results will be printed to STDOUT as TITLE followed by the times.
 143 TITLE defaults to "timethis COUNT" if none is provided. STYLE
 144 determines the format of the output, as described for timestr() below.
 145
 146 The COUNT can be zero or negative: this means the I<minimum number of
 147 CPU seconds> to run.  A zero signifies the default of 3 seconds.  For
 148 example to run at least for 10 seconds:
 149
 150         timethis(-10, $code)
 151
 152 or to run two pieces of code tests for at least 3 seconds:
 153
 154         timethese(0, { test1 => '...', test2 => '...'})
 155
 156 CPU seconds is, in UNIX terms, the user time plus the system time of
 157 the process itself, as opposed to the real (wallclock) time and the
 158 time spent by the child processes.  Less than 0.1 seconds is not
 159 accepted (-0.01 as the count, for example, will cause a fatal runtime
 160 exception).
 161
 162 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
 163 other operating system factors may complicate the attempt so that a
 164 little bit more time is spent.  The benchmark output will, however,
 165 also tell the number of C<$code> runs/second, which should be a more
 166 interesting number than the actually spent seconds.
 167
 168 Returns a Benchmark object.
 169
 170 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
 171
 172 The CODEHASHREF is a reference to a hash containing names as keys
 173 and either a string to eval or a code reference for each value.
 174 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
 175 call
 176
 177         timethis(COUNT, VALUE, KEY, STYLE)
 178
 179 The routines are called in string comparison order of KEY.
 180
 181 The COUNT can be zero or negative, see timethis().
 182
 183 Returns a hash of Benchmark objects, keyed by name.
 184
 185 =item timediff ( T1, T2 )
 186
 187 Returns the difference between two Benchmark times as a Benchmark
 188 object suitable for passing to timestr().
 189
 190 =item timesum ( T1, T2 )
 191
 192 Returns the sum of two Benchmark times as a Benchmark object suitable
 193 for passing to timestr().
 194
 195 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
 196
 197 Returns a string that formats the times in the TIMEDIFF object in
 198 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
 199 similar to that returned by timediff().
 200
 201 STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
 202 each of the 5 times available ('wallclock' time, user time, system time,
 203 user time of children, and system time of children). 'noc' shows all
 204 except the two children times. 'nop' shows only wallclock and the
 205 two children times. 'auto' (the default) will act as 'all' unless
 206 the children times are both zero, in which case it acts as 'noc'.
 207 'none' prevents output.
 208
 209 FORMAT is the L<printf(3)>-style format specifier (without the
 210 leading '%') to use to print the times. It defaults to '5.2f'.
 211
 212 =back
 213
 214 =head2 Optional Exports
 215
 216 The following routines will be exported into your namespace
 217 if you specifically ask that they be imported:
 218
 219 =over 10
 220
 221 =item clearcache ( COUNT )
 222
 223 Clear the cached time for COUNT rounds of the null loop.
 224
 225 =item clearallcache ( )
 226
 227 Clear all cached times.
 228
 229 =item disablecache ( )
 230
 231 Disable caching of timings for the null loop. This will force Benchmark
 232 to recalculate these timings for each new piece of code timed.
 233
 234 =item enablecache ( )
 235
 236 Enable caching of timings for the null loop. The time taken for COUNT
 237 rounds of the null loop will be calculated only once for each
 238 different COUNT used.
 239
 240 =back
 241
 242 =head1 NOTES
 243
 244 The data is stored as a list of values from the time and times
 245 functions:
 246
 247       ($real, $user, $system, $children_user, $children_system, $iters)
 248
 249 in seconds for the whole loop (not divided by the number of rounds).
 250
 251 The timing is done using time(3) and times(3).
 252
 253 Code is executed in the caller's package.
 254
 255 The time of the null loop (a loop with the same
 256 number of rounds but empty loop body) is subtracted
 257 from the time of the real loop.
 258
 259 The null loop times can be cached, the key being the
 260 number of rounds. The caching can be controlled using
 261 calls like these:
 262
 263     clearcache($key);
 264     clearallcache();
 265
 266     disablecache();
 267     enablecache();
 268
 269 Caching is off by default, as it can (usually slightly) decrease
 270 accuracy and does not usually noticably affect runtimes.
 271
 272 =head1 INHERITANCE
 273
 274 Benchmark inherits from no other class, except of course
 275 for Exporter.
 276
 277 =head1 CAVEATS
 278
 279 Comparing eval'd strings with code references will give you
 280 inaccurate results: a code reference will show a slightly slower
 281 execution time than the equivalent eval'd string.
 282
 283 The real time timing is done using time(2) and
 284 the granularity is therefore only one second.
 285
 286 Short tests may produce negative figures because perl
 287 can appear to take longer to execute the empty loop
 288 than a short test; try:
 289
 290     timethis(100,'1');
 291
 292 The system time of the null loop might be slightly
 293 more than the system time of the loop with the actual
 294 code and therefore the difference might end up being E<lt> 0.
 295
 296 =head1 AUTHORS
 297
 298 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 299
 300 =head1 MODIFICATION HISTORY
 301
 302 September 8th, 1994; by Tim Bunce.
 303
 304 March 28th, 1997; by Hugo van der Sanden: added support for code
 305 references and the already documented 'debug' method; revamped
 306 documentation.
 307
 308 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 309 functionality.
 310
 311 September, 1999; by Barrie Slaymaker: math fixes and accuracy and
 312 efficiency tweaks.  Added cmpthese().  A result is now returned from
 313 timethese().  Exposed countit() (was runfor()).
 314
 315 =cut
 316
 317 # evaluate something in a clean lexical environment
 318 sub _doeval { eval shift }
 319
 320 #
 321 # put any lexicals at file scope AFTER here
 322 #
 323
 324 use Carp;
 325 use Exporter;
 326 @ISA=(Exporter);
 327 @EXPORT=qw(cmpthese countit timeit timethis timethese timediff timestr);
 328 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
 329
 330 &init;
 331
 332 sub 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
 345 sub debug { $debug = ($_[1] != 0); }
 346
 347 # The cache needs two branches: 's' for strings and 'c' for code.  The
 348 # emtpy loop is different in these two cases.
 349 sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
 350 sub clearallcache { %cache = (); }
 351 sub enablecache   { $cache = 1; }
 352 sub disablecache  { $cache = 0; }
 353
 354 # --- Functions to process the 'time' data type
 355
 356 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
 357           print "new=@t\n" if $debug;
 358           bless \@t; }
 359
 360 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 361 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 362 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 363 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 364 sub iters { $_[0]->[5] ; }
 365
 366 sub timediff {
 367     my($a, $b) = @_;
 368     my @r;
 369     for (my $i=0; $i < @$a; ++$i) {
 370         push(@r, $a->[$i] - $b->[$i]);
 371     }
 372     bless \@r;
 373 }
 374
 375 sub 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
 384 sub timestr {
 385     my($tr, $style, $f) = @_;
 386     my @t = @$tr;
 387     warn "bad time value (@t)" unless @t==6;
 388     my($r, $pu, $ps, $cu, $cs, $n) = @t;
 389     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 390     $f = $defaultfmt unless defined $f;
 391     # format a time in the required style, other formats may be added here
 392     $style ||= $defaultstyle;
 393     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 394     my $s = "@t $style"; # default for unknown style
 395     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
 396                             @t,$t) if $style eq 'all';
 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';
 401     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
 402     $s;
 403 }
 404
 405 sub timedebug {
 406     my($msg, $t) = @_;
 407     print STDERR "$msg",timestr($t),"\n" if $debug;
 408 }
 409
 410 # --- Functions implementing low-level support for timing loops
 411
 412 sub runloop {
 413     my($n, $c) = @_;
 414
 415     $n+=0; # force numeric now, so garbage won't creep into the eval
 416     croak "negative loopcount $n" if $n<0;
 417     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 418     my($t0, $t1, $td); # before, after, difference
 419
 420     # find package of caller so we can execute code there
 421     my($curpack) = caller(0);
 422     my($i, $pack)= 0;
 423     while (($pack) = caller(++$i)) {
 424         last if $pack ne $curpack;
 425     }
 426
 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     }
 436     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 437     print STDERR "runloop $n '$subcode'\n" if $debug;
 438
 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
 443     # in &countit.  This, in turn, can reduce the number of calls to
 444     # &runloop a lot, and thus reduce additive errors.
 445     my $tbase = Benchmark->new(0)->[1];
 446     do {
 447        $t0 = Benchmark->new(0);
 448     } while ( $t0->[1] == $tbase );
 449     &$subref;
 450     $t1 = Benchmark->new($n);
 451     $td = &timediff($t1, $t0);
 452     timedebug("runloop:",$td);
 453     $td;
 454 }
 455
 456
 457 sub timeit {
 458     my($n, $code) = @_;
 459     my($wn, $wc, $wd);
 460
 461     printf STDERR "timeit $n $code\n" if $debug;
 462     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
 463     if ($cache && exists $cache{$cache_key} ) {
 464         $wn = $cache{$cache_key};
 465     } else {
 466         $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
 467         # Can't let our baseline have any iterations, or they get subtracted
 468         # out of the result.
 469         $wn->[5] = 0;
 470         $cache{$cache_key} = $wn;
 471     }
 472
 473     $wc = &runloop($n, $code);
 474
 475     $wd = timediff($wc, $wn);
 476     timedebug("timeit: ",$wc);
 477     timedebug("      - ",$wn);
 478     timedebug("      = ",$wd);
 479
 480     $wd;
 481 }
 482
 483
 484 my $default_for = 3;
 485 my $min_for     = 0.1;
 486
 487
 488 sub countit {
 489     my ( $tmax, $code ) = @_;
 490
 491     if ( not defined $tmax or $tmax == 0 ) {
 492         $tmax = $default_for;
 493     } elsif ( $tmax < 0 ) {
 494         $tmax = -$tmax;
 495     }
 496
 497     die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
 498         if $tmax < $min_for;
 499
 500     my ($n, $tc);
 501
 502     # First find the minimum $n that gives a significant timing.
 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     }
 508
 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);
 520         $tc = $td->[1] + $td->[2];
 521     }
 522
 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];
 544         $cutot += $td->[3];
 545         $cstot += $td->[4];
 546         $ttot = $utot + $stot;
 547         last if $ttot >= $tmax;
 548
 549         my $r = $tmax / $ttot - 1; # Linear approximation.
 550         $n = int( $r * $ntot );
 551         $n = $nmin if $n < $nmin;
 552     }
 553
 554     return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
 555 }
 556
 557 # --- Functions implementing high-level time-then-print utilities
 558
 559 sub n_to_for {
 560     my $n = shift;
 561     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 562 }
 563
 564 sub timethis{
 565     my($n, $code, $title, $style) = @_;
 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 );
 574         $t     = countit( $fort, $code );
 575         $title = "timethis for $fort" unless defined $title;
 576         $forn  = $t->[-1];
 577     }
 578     local $| = 1;
 579     $style = "" unless defined $style;
 580     printf("%10s: ", $title) unless $style eq 'none';
 581     print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
 582
 583     $n = $forn if defined $forn;
 584
 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"
 589         if     $n < $min_count
 590             || ($t->real < 1 && $n < 1000)
 591             || $t->cpu_a < $min_cpu;
 592     $t;
 593 }
 594
 595 sub timethese{
 596     my($n, $alt, $style) = @_;
 597     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 598                 unless ref $alt eq HASH;
 599     my @names = sort keys %$alt;
 600     $style = "" unless defined $style;
 601     print "Benchmark: " unless $style eq 'none';
 602     if ( $n > 0 ) {
 603         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 604         print "timing $n iterations of" unless $style eq 'none';
 605     } else {
 606         print "running" unless $style eq 'none';
 607     }
 608     print " ", join(', ',@names) unless $style eq 'none';
 609     unless ( $n > 0 ) {
 610         my $for = n_to_for( $n );
 611         print ", each for at least $for CPU seconds" unless $style eq 'none';
 612     }
 613     print "...\n" unless $style eq 'none';
 614
 615     # we could save the results in an array and produce a summary here
 616     # sum, min, max, avg etc etc
 617     my %results;
 618     foreach my $name (@names) {
 619         $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
 620     }
 621
 622     return \%results;
 623 }
 624
 625 sub 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
 760 1;