8 Benchmark - benchmark running times of Perl code
12 use Benchmark qw(:all) ;
14 timethis ($count, "code");
16 # Use Perl code in strings...
18 'Name1' => '...code1...',
19 'Name2' => '...code2...',
22 # ... or use subroutine references.
24 'Name1' => sub { ...code1... },
25 'Name2' => sub { ...code2... },
28 # cmpthese can be used both ways as well
30 'Name1' => '...code1...',
31 'Name2' => '...code2...',
35 'Name1' => sub { ...code1... },
36 'Name2' => sub { ...code2... },
40 $results = timethese($count,
42 'Name1' => sub { ...code1... },
43 'Name2' => sub { ...code2... },
47 cmpthese( $results ) ;
49 $t = timeit($count, '...other code...')
50 print "$count loops of other code took:",timestr($t),"\n";
52 $t = countit($time, '...other code...')
54 print "$count loops of other code took:",timestr($t),"\n";
56 # enable hires wallclock timing if possible
57 use Benchmark ':hireswallclock';
61 The Benchmark module encapsulates a number of routines to help you
62 figure out how long it takes to execute some code.
64 timethis - run a chunk of code several times
66 timethese - run several chunks of code several times
68 cmpthese - print results of timethese as a comparison chart
70 timeit - run a chunk of code and see how long it goes
72 countit - see how many times a chunk of code runs in a given time
81 Returns the current time. Example:
85 # ... your code here ...
87 $td = timediff($t1, $t0);
88 print "the code took:",timestr($td),"\n";
92 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
95 $t = timeit(10, ' 5 ** $Global ');
100 Returns the number of iterations.
104 =head2 Standard Exports
106 The following routines will be exported into your namespace
107 if you use the Benchmark module:
111 =item timeit(COUNT, CODE)
113 Arguments: COUNT is the number of times to run the loop, and CODE is
114 the code to run. CODE may be either a code reference or a string to
115 be eval'd; either way it will be run in the caller's package.
117 Returns: a Benchmark object.
119 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
121 Time COUNT iterations of CODE. CODE may be a string to eval or a
122 code reference; either way the CODE will run in the caller's package.
123 Results will be printed to STDOUT as TITLE followed by the times.
124 TITLE defaults to "timethis COUNT" if none is provided. STYLE
125 determines the format of the output, as described for timestr() below.
127 The COUNT can be zero or negative: this means the I<minimum number of
128 CPU seconds> to run. A zero signifies the default of 3 seconds. For
129 example to run at least for 10 seconds:
133 or to run two pieces of code tests for at least 3 seconds:
135 timethese(0, { test1 => '...', test2 => '...'})
137 CPU seconds is, in UNIX terms, the user time plus the system time of
138 the process itself, as opposed to the real (wallclock) time and the
139 time spent by the child processes. Less than 0.1 seconds is not
140 accepted (-0.01 as the count, for example, will cause a fatal runtime
143 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
144 other operating system factors may complicate the attempt so that a
145 little bit more time is spent. The benchmark output will, however,
146 also tell the number of C<$code> runs/second, which should be a more
147 interesting number than the actually spent seconds.
149 Returns a Benchmark object.
151 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
153 The CODEHASHREF is a reference to a hash containing names as keys
154 and either a string to eval or a code reference for each value.
155 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
158 timethis(COUNT, VALUE, KEY, STYLE)
160 The routines are called in string comparison order of KEY.
162 The COUNT can be zero or negative, see timethis().
164 Returns a hash reference of Benchmark objects, keyed by name.
166 =item timediff ( T1, T2 )
168 Returns the difference between two Benchmark times as a Benchmark
169 object suitable for passing to timestr().
171 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
173 Returns a string that formats the times in the TIMEDIFF object in
174 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
175 similar to that returned by timediff().
177 STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
178 each of the 5 times available ('wallclock' time, user time, system time,
179 user time of children, and system time of children). 'noc' shows all
180 except the two children times. 'nop' shows only wallclock and the
181 two children times. 'auto' (the default) will act as 'all' unless
182 the children times are both zero, in which case it acts as 'noc'.
183 'none' prevents output.
185 FORMAT is the L<printf(3)>-style format specifier (without the
186 leading '%') to use to print the times. It defaults to '5.2f'.
190 =head2 Optional Exports
192 The following routines will be exported into your namespace
193 if you specifically ask that they be imported:
197 =item clearcache ( COUNT )
199 Clear the cached time for COUNT rounds of the null loop.
201 =item clearallcache ( )
203 Clear all cached times.
205 =item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
207 =item cmpthese ( RESULTSHASHREF, [ STYLE ] )
209 Optionally calls timethese(), then outputs comparison chart. This:
211 cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
213 outputs a chart like:
219 This chart is sorted from slowest to fastest, and shows the percent speed
220 difference between each pair of tests.
222 c<cmpthese> can also be passed the data structure that timethese() returns:
224 $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
225 cmpthese( $results );
227 in case you want to see both sets of results.
228 If the first argument is an unblessed hash reference,
229 that is RESULTSHASHREF; otherwise that is COUNT.
231 Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
232 above chart, including labels. This:
234 my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
236 returns a data structure like:
239 [ '', 'Rate', 'b', 'a' ],
240 [ 'b', '2885232/s', '--', '-59%' ],
241 [ 'a', '7099126/s', '146%', '--' ],
244 B<NOTE>: This result value differs from previous versions, which returned
245 the C<timethese()> result structure. If you want that, just use the two
246 statement C<timethese>...C<cmpthese> idiom shown above.
248 Incidently, note the variance in the result values between the two examples;
249 this is typical of benchmarking. If this were a real benchmark, you would
250 probably want to run a lot more iterations.
252 =item countit(TIME, CODE)
254 Arguments: TIME is the minimum length of time to run CODE for, and CODE is
255 the code to run. CODE may be either a code reference or a string to
256 be eval'd; either way it will be run in the caller's package.
258 TIME is I<not> negative. countit() will run the loop many times to
259 calculate the speed of CODE before running it for TIME. The actual
260 time run for will usually be greater than TIME due to system clock
261 resolution, so it's best to look at the number of iterations divided
262 by the times that you are concerned with, not just the iterations.
264 Returns: a Benchmark object.
266 =item disablecache ( )
268 Disable caching of timings for the null loop. This will force Benchmark
269 to recalculate these timings for each new piece of code timed.
271 =item enablecache ( )
273 Enable caching of timings for the null loop. The time taken for COUNT
274 rounds of the null loop will be calculated only once for each
275 different COUNT used.
277 =item timesum ( T1, T2 )
279 Returns the sum of two Benchmark times as a Benchmark object suitable
280 for passing to timestr().
284 =head2 :hireswallclock
286 If the Time::HiRes module has been installed, you can specify the
287 special tag C<:hireswallclock> for Benchmark (if Time::HiRes is not
288 available, the tag will be silently ignored). This tag will cause the
289 wallclock time to be measured in microseconds, instead of integer
290 seconds. Note though that the speed computations are still conducted
291 in CPU time, not wallclock time.
295 The data is stored as a list of values from the time and times
298 ($real, $user, $system, $children_user, $children_system, $iters)
300 in seconds for the whole loop (not divided by the number of rounds).
302 The timing is done using time(3) and times(3).
304 Code is executed in the caller's package.
306 The time of the null loop (a loop with the same
307 number of rounds but empty loop body) is subtracted
308 from the time of the real loop.
310 The null loop times can be cached, the key being the
311 number of rounds. The caching can be controlled using
320 Caching is off by default, as it can (usually slightly) decrease
321 accuracy and does not usually noticably affect runtimes.
327 use Benchmark qw( cmpthese ) ;
334 outputs something like this:
336 Benchmark: running a, b, each for at least 5 CPU seconds...
344 use Benchmark qw( timethese cmpthese ) ;
346 $r = timethese( -5, {
352 outputs something like this:
354 Benchmark: running a, b, each for at least 5 CPU seconds...
355 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
356 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
364 Benchmark inherits from no other class, except of course
369 Comparing eval'd strings with code references will give you
370 inaccurate results: a code reference will show a slightly slower
371 execution time than the equivalent eval'd string.
373 The real time timing is done using time(2) and
374 the granularity is therefore only one second.
376 Short tests may produce negative figures because perl
377 can appear to take longer to execute the empty loop
378 than a short test; try:
382 The system time of the null loop might be slightly
383 more than the system time of the loop with the actual
384 code and therefore the difference might end up being E<lt> 0.
388 L<Devel::DProf> - a Perl code profiler
392 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
394 =head1 MODIFICATION HISTORY
396 September 8th, 1994; by Tim Bunce.
398 March 28th, 1997; by Hugo van der Sanden: added support for code
399 references and the already documented 'debug' method; revamped
402 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
405 September, 1999; by Barrie Slaymaker: math fixes and accuracy and
406 efficiency tweaks. Added cmpthese(). A result is now returned from
407 timethese(). Exposed countit() (was runfor()).
409 December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
410 and return an empty string. If cmpthese is calling timethese, make it pass the
411 style in. (so that 'none' will suppress output). Make sub new dump its
412 debugging output to STDERR, to be consistent with everything else.
413 All bugs found while writing a regression test.
415 September, 2002; by Jarkko Hietaniemi: add ':hireswallclock' special tag.
417 February, 2004; by Chia-liang Kao: make cmpthese and timestr use time
418 statistics for children instead of parent when the style is 'nop'.
422 # evaluate something in a clean lexical environment
423 sub _doeval { no strict; eval shift }
426 # put any lexicals at file scope AFTER here
432 our(@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
435 @EXPORT=qw(timeit timethis timethese timediff timestr);
436 @EXPORT_OK=qw(timesum cmpthese countit
437 clearcache clearallcache disablecache enablecache);
438 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
442 # --- ':hireswallclock' special handling
446 sub mytime () { time }
451 if (eval 'require Time::HiRes') {
452 import Time::HiRes qw(time);
453 $hirestime = \&Time::HiRes::time;
459 if (grep { $_ eq ":hireswallclock" } @_) {
460 @_ = grep { $_ ne ":hireswallclock" } @_;
462 *mytime = $hirestime if defined $hirestime;
464 Benchmark->export_to_level(1, $class, @_);
467 our($Debug, $Min_Count, $Min_CPU, $Default_Format, $Default_Style,
468 %_Usage, %Cache, $Do_Cache);
474 $Default_Format = '5.2f';
475 $Default_Style = 'auto';
476 # The cache can cause a slight loss of sys time accuracy. If a
477 # user does many tests (>10) with *very* large counts (>10000)
478 # or works on a very slow machine the cache may be useful.
483 sub debug { $Debug = ($_[1] != 0); }
486 my $calling_sub = (caller(1))[3];
487 $calling_sub =~ s/^Benchmark:://;
488 return $_Usage{$calling_sub} || '';
491 # The cache needs two branches: 's' for strings and 'c' for code. The
492 # empty loop is different in these two cases.
494 $_Usage{clearcache} = <<'USAGE';
495 usage: clearcache($count);
499 die usage unless @_ == 1;
500 delete $Cache{"$_[0]c"}; delete $Cache{"$_[0]s"};
503 $_Usage{clearallcache} = <<'USAGE';
504 usage: clearallcache();
512 $_Usage{enablecache} = <<'USAGE';
513 usage: enablecache();
521 $_Usage{disablecache} = <<'USAGE';
522 usage: disablecache();
531 # --- Functions to process the 'time' data type
533 sub new { my @t = (mytime, times, @_ == 2 ? $_[1] : 0);
534 print STDERR "new=@t\n" if $Debug;
537 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
538 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
539 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
540 sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
541 sub iters { $_[0]->[5] ; }
544 $_Usage{timediff} = <<'USAGE';
545 usage: $result_diff = timediff($result1, $result2);
551 die usage unless ref $a and ref $b;
554 for (my $i=0; $i < @$a; ++$i) {
555 push(@r, $a->[$i] - $b->[$i]);
557 #die "Bad timediff(): ($r[1] + $r[2]) <= 0 (@$a[1,2]|@$b[1,2])\n"
558 # if ($r[1] + $r[2]) < 0;
562 $_Usage{timesum} = <<'USAGE';
563 usage: $sum = timesum($result1, $result2);
569 die usage unless ref $a and ref $b;
572 for (my $i=0; $i < @$a; ++$i) {
573 push(@r, $a->[$i] + $b->[$i]);
579 $_Usage{timestr} = <<'USAGE';
580 usage: $formatted_result = timestr($result1);
584 my($tr, $style, $f) = @_;
586 die usage unless ref $tr;
589 warn "bad time value (@t)" unless @t==6;
590 my($r, $pu, $ps, $cu, $cs, $n) = @t;
591 my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
592 $f = $Default_Format unless defined $f;
593 # format a time in the required style, other formats may be added here
594 $style ||= $Default_Style;
595 return '' if $style eq 'none';
596 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
597 my $s = "@t $style"; # default for unknown style
598 my $w = $hirestime ? "%2g" : "%2d";
599 $s=sprintf("$w wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
600 $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
601 $s=sprintf("$w wallclock secs (%$f usr + %$f sys = %$f CPU)",
602 $r,$pu,$ps,$pt) if $style eq 'noc';
603 $s=sprintf("$w wallclock secs (%$f cusr + %$f csys = %$f CPU)",
604 $r,$cu,$cs,$ct) if $style eq 'nop';
605 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $style eq 'nop' ? $cu + $cs : $pu + $ps ))
606 if $n && ($style eq 'nop' ? $cu+$cs : $pu+$ps);
612 print STDERR "$msg",timestr($t),"\n" if $Debug;
615 # --- Functions implementing low-level support for timing loops
617 $_Usage{runloop} = <<'USAGE';
618 usage: runloop($number, [$string | $coderef])
624 $n+=0; # force numeric now, so garbage won't creep into the eval
625 croak "negative loopcount $n" if $n<0;
626 confess usage unless defined $c;
627 my($t0, $t1, $td); # before, after, difference
629 # find package of caller so we can execute code there
630 my($curpack) = caller(0);
632 while (($pack) = caller(++$i)) {
633 last if $pack ne $curpack;
636 my ($subcode, $subref);
637 if (ref $c eq 'CODE') {
638 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
639 $subref = eval $subcode;
642 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
643 $subref = _doeval($subcode);
645 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
646 print STDERR "runloop $n '$subcode'\n" if $Debug;
648 # Wait for the user timer to tick. This makes the error range more like
649 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
650 # may not seem important, but it significantly reduces the chances of
651 # getting a too low initial $n in the initial, 'find the minimum' loop
652 # in &countit. This, in turn, can reduce the number of calls to
653 # &runloop a lot, and thus reduce additive errors.
654 my $tbase = Benchmark->new(0)->[1];
655 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
657 $t1 = Benchmark->new($n);
658 $td = &timediff($t1, $t0);
659 timedebug("runloop:",$td);
663 $_Usage{timeit} = <<'USAGE';
664 usage: $result = timeit($count, 'code' ); or
665 $result = timeit($count, sub { code } );
672 die usage unless defined $code and
673 (!ref $code or ref $code eq 'CODE');
675 printf STDERR "timeit $n $code\n" if $Debug;
676 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
677 if ($Do_Cache && exists $Cache{$cache_key} ) {
678 $wn = $Cache{$cache_key};
680 $wn = &runloop($n, ref( $code ) ? sub { } : '' );
681 # Can't let our baseline have any iterations, or they get subtracted
684 $Cache{$cache_key} = $wn;
687 $wc = &runloop($n, $code);
689 $wd = timediff($wc, $wn);
690 timedebug("timeit: ",$wc);
691 timedebug(" - ",$wn);
692 timedebug(" = ",$wd);
702 $_Usage{countit} = <<'USAGE';
703 usage: $result = countit($time, 'code' ); or
704 $result = countit($time, sub { code } );
708 my ( $tmax, $code ) = @_;
712 if ( not defined $tmax or $tmax == 0 ) {
713 $tmax = $default_for;
714 } elsif ( $tmax < 0 ) {
718 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
723 # First find the minimum $n that gives a significant timing.
725 for ($n = 1; ; $n *= 2 ) {
726 my $td = timeit($n, $code);
727 $tc = $td->[1] + $td->[2];
728 if ( $tc <= 0 and $n > 1024 ) {
730 and die "Timing is consistently zero in estimation loop, cannot benchmark. N=$n\n";
739 # Get $n high enough that we can guess the final $n with some accuracy.
740 my $tpra = 0.1 * $tmax; # Target/time practice.
741 while ( $tc < $tpra ) {
742 # The 5% fudge is to keep us from iterating again all
743 # that often (this speeds overall responsiveness when $tmax is big
744 # and we guess a little low). This does not noticably affect
745 # accuracy since we're not couting these times.
746 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
747 my $td = timeit($n, $code);
748 my $new_tc = $td->[1] + $td->[2];
749 # Make sure we are making progress.
750 $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
753 # Now, do the 'for real' timing(s), repeating until we exceed
763 # The 5% fudge is because $n is often a few % low even for routines
764 # with stable times and avoiding extra timeit()s is nice for
766 $n = int( $n * ( 1.05 * $tmax / $tc ) );
769 my $td = timeit($n, $code);
776 $ttot = $utot + $stot;
777 last if $ttot >= $tmax;
780 and die "Timing is consistently zero, cannot benchmark. N=$n\n";
784 $ttot = 0.01 if $ttot < 0.01;
785 my $r = $tmax / $ttot - 1; # Linear approximation.
786 $n = int( $r * $ntot );
787 $n = $nmin if $n < $nmin;
790 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
793 # --- Functions implementing high-level time-then-print utilities
797 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
800 $_Usage{timethis} = <<'USAGE';
801 usage: $result = timethis($time, 'code' ); or
802 $result = timethis($time, sub { code } );
806 my($n, $code, $title, $style) = @_;
809 die usage unless defined $code and
810 (!ref $code or ref $code eq 'CODE');
813 croak "non-integer loopcount $n, stopped" if int($n)<$n;
814 $t = timeit($n, $code);
815 $title = "timethis $n" unless defined $title;
817 my $fort = n_to_for( $n );
818 $t = countit( $fort, $code );
819 $title = "timethis for $fort" unless defined $title;
823 $style = "" unless defined $style;
824 printf("%10s: ", $title) unless $style eq 'none';
825 print timestr($t, $style, $Default_Format),"\n" unless $style eq 'none';
827 $n = $forn if defined $forn;
829 # A conservative warning to spot very silly tests.
830 # Don't assume that your benchmark is ok simply because
831 # you don't get this warning!
832 print " (warning: too few iterations for a reliable count)\n"
834 || ($t->real < 1 && $n < 1000)
835 || $t->cpu_a < $Min_CPU;
840 $_Usage{timethese} = <<'USAGE';
841 usage: timethese($count, { Name1 => 'code1', ... }); or
842 timethese($count, { Name1 => sub { code1 }, ... });
846 my($n, $alt, $style) = @_;
847 die usage unless ref $alt eq 'HASH';
849 my @names = sort keys %$alt;
850 $style = "" unless defined $style;
851 print "Benchmark: " unless $style eq 'none';
853 croak "non-integer loopcount $n, stopped" if int($n)<$n;
854 print "timing $n iterations of" unless $style eq 'none';
856 print "running" unless $style eq 'none';
858 print " ", join(', ',@names) unless $style eq 'none';
860 my $for = n_to_for( $n );
861 print ", each" if $n > 1 && $style ne 'none';
862 print " for at least $for CPU seconds" unless $style eq 'none';
864 print "...\n" unless $style eq 'none';
866 # we could save the results in an array and produce a summary here
867 # sum, min, max, avg etc etc
869 foreach my $name (@names) {
870 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
877 $_Usage{cmpthese} = <<'USAGE';
878 usage: cmpthese($count, { Name1 => 'code1', ... }); or
879 cmpthese($count, { Name1 => sub { code1 }, ... }); or
880 cmpthese($result, $style);
884 my ($results, $style);
886 # $count can be a blessed object.
887 if ( ref $_[0] eq 'HASH' ) {
888 ($results, $style) = @_;
891 my($count, $code) = @_[0,1];
892 $style = $_[2] if defined $_[2];
894 die usage unless ref $code eq 'HASH';
896 $results = timethese($count, $code, ($style || "none"));
899 $style = "" unless defined $style;
901 # Flatten in to an array of arrays with the name as the first field
902 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
905 # The epsilon fudge here is to prevent div by 0. Since clock
906 # resolutions are much larger, it's below the noise floor.
907 my $rate = $_->[6] / (( $style eq 'nop' ? $_->[4] + $_->[5]
908 : $_->[2] + $_->[3]) + 0.000000000000001 );
913 @vals = sort { $a->[7] <=> $b->[7] } @vals;
915 # If more than half of the rates are greater than one...
916 my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;
923 $display_as_rate ? 'Rate' : 's/iter',
924 map { $_->[0] } @vals
927 push @rows, \@top_row;
928 @col_widths = map { length( $_ ) } @top_row;
930 # Build the data rows
931 # We leave the last column in even though it never has any data. Perhaps
932 # it should go away. Also, perhaps a style for a single column of
933 # percentages might be nice.
934 for my $row_val ( @vals ) {
937 # Column 0 = test name
938 push @row, $row_val->[0];
939 $col_widths[0] = length( $row_val->[0] )
940 if length( $row_val->[0] ) > $col_widths[0];
942 # Column 1 = performance
943 my $row_rate = $row_val->[7];
945 # We assume that we'll never get a 0 rate.
946 my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;
948 # Only give a few decimal places before switching to sci. notation,
949 # since the results aren't usually that accurate anyway.
964 my $formatted_rate = sprintf( $format, $rate );
965 push @row, $formatted_rate;
966 $col_widths[1] = length( $formatted_rate )
967 if length( $formatted_rate ) > $col_widths[1];
969 # Columns 2..N = performance ratios
971 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
972 my $col_val = $vals[$col_num];
977 elsif ( $col_val->[0] eq $row_val->[0] ) {
982 my $col_rate = $col_val->[7];
983 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
986 $col_widths[$col_num+2] = length( $out )
987 if length( $out ) > $col_widths[$col_num+2];
989 # A little wierdness to set the first column width properly
990 $col_widths[$col_num+2] = length( $col_val->[0] )
991 if length( $col_val->[0] ) > $col_widths[$col_num+2];
996 return \@rows if $style eq "none";
998 # Equalize column widths in the chart as much as possible without
999 # exceeding 80 characters. This does not use or affect cols 0 or 1.
1000 my @sorted_width_refs =
1001 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
1002 my $max_width = ${$sorted_width_refs[-1]};
1004 my $total = @col_widths - 1 ;
1005 for ( @col_widths ) { $total += $_ }
1008 while ( $total < 80 ) {
1009 my $min_width = ${$sorted_width_refs[0]};
1011 if $min_width == $max_width;
1012 for ( @sorted_width_refs ) {
1014 if $$_ > $min_width;
1023 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
1024 substr( $format, 1, 0 ) = '-';
1026 printf $format, @$_;