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