5 Benchmark - benchmark running times of code
7 timethis - run a chunk of code several times
9 timethese - run several chunks of code several times
11 cmpthese - print results of timethese as a comparison chart
13 timeit - run a chunk of code and see how long it goes
15 countit - see how many times a chunk of code runs in a given time
19 timethis ($count, "code");
21 # Use Perl code in strings...
23 'Name1' => '...code1...',
24 'Name2' => '...code2...',
27 # ... or use subroutine references.
29 'Name1' => sub { ...code1... },
30 'Name2' => sub { ...code2... },
33 # cmpthese can be used both ways as well
35 'Name1' => '...code1...',
36 'Name2' => '...code2...',
40 'Name1' => sub { ...code1... },
41 'Name2' => sub { ...code2... },
45 $results = timethese($count,
47 'Name1' => sub { ...code1... },
48 'Name2' => sub { ...code2... },
52 cmpthese( $results ) ;
54 $t = timeit($count, '...other code...')
55 print "$count loops of other code took:",timestr($t),"\n";
57 $t = countit($time, '...other code...')
59 print "$count loops of other code took:",timestr($t),"\n";
63 The Benchmark module encapsulates a number of routines to help you
64 figure out how long it takes to execute some code.
72 Returns the current time. Example:
76 # ... your code here ...
78 $td = timediff($t1, $t0);
79 print "the code took:",timestr($td),"\n";
83 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
86 $t = timeit(10, ' 5 ** $Global ');
91 Returns the number of iterations.
95 =head2 Standard Exports
97 The following routines will be exported into your namespace
98 if you use the Benchmark module:
102 =item timeit(COUNT, CODE)
104 Arguments: COUNT is the number of times to run the loop, and CODE is
105 the code to run. CODE may be either a code reference or a string to
106 be eval'd; either way it will be run in the caller's package.
108 Returns: a Benchmark object.
110 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
112 Time COUNT iterations of CODE. CODE may be a string to eval or a
113 code reference; either way the CODE will run in the caller's package.
114 Results will be printed to STDOUT as TITLE followed by the times.
115 TITLE defaults to "timethis COUNT" if none is provided. STYLE
116 determines the format of the output, as described for timestr() below.
118 The COUNT can be zero or negative: this means the I<minimum number of
119 CPU seconds> to run. A zero signifies the default of 3 seconds. For
120 example to run at least for 10 seconds:
124 or to run two pieces of code tests for at least 3 seconds:
126 timethese(0, { test1 => '...', test2 => '...'})
128 CPU seconds is, in UNIX terms, the user time plus the system time of
129 the process itself, as opposed to the real (wallclock) time and the
130 time spent by the child processes. Less than 0.1 seconds is not
131 accepted (-0.01 as the count, for example, will cause a fatal runtime
134 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
135 other operating system factors may complicate the attempt so that a
136 little bit more time is spent. The benchmark output will, however,
137 also tell the number of C<$code> runs/second, which should be a more
138 interesting number than the actually spent seconds.
140 Returns a Benchmark object.
142 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
144 The CODEHASHREF is a reference to a hash containing names as keys
145 and either a string to eval or a code reference for each value.
146 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
149 timethis(COUNT, VALUE, KEY, STYLE)
151 The routines are called in string comparison order of KEY.
153 The COUNT can be zero or negative, see timethis().
155 Returns a hash of Benchmark objects, keyed by name.
157 =item timediff ( T1, T2 )
159 Returns the difference between two Benchmark times as a Benchmark
160 object suitable for passing to timestr().
162 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
164 Returns a string that formats the times in the TIMEDIFF object in
165 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
166 similar to that returned by timediff().
168 STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
169 each of the 5 times available ('wallclock' time, user time, system time,
170 user time of children, and system time of children). 'noc' shows all
171 except the two children times. 'nop' shows only wallclock and the
172 two children times. 'auto' (the default) will act as 'all' unless
173 the children times are both zero, in which case it acts as 'noc'.
174 'none' prevents output.
176 FORMAT is the L<printf(3)>-style format specifier (without the
177 leading '%') to use to print the times. It defaults to '5.2f'.
181 =head2 Optional Exports
183 The following routines will be exported into your namespace
184 if you specifically ask that they be imported:
188 =item clearcache ( COUNT )
190 Clear the cached time for COUNT rounds of the null loop.
192 =item clearallcache ( )
194 Clear all cached times.
196 =item cmpthese ( COUT, CODEHASHREF, [ STYLE ] )
198 =item cmpthese ( RESULTSHASHREF )
200 Optionally calls timethese(), then outputs comparison chart. This
201 chart is sorted from slowest to fastest, and shows the percent
202 speed difference between each pair of tests. Can also be passed
203 the data structure that timethese() returns:
205 $results = timethese( .... );
206 cmpthese( $results );
208 Returns the data structure returned by timethese() (or passed in).
210 =item countit(TIME, CODE)
212 Arguments: TIME is the minimum length of time to run CODE for, and CODE is
213 the code to run. CODE may be either a code reference or a string to
214 be eval'd; either way it will be run in the caller's package.
216 TIME is I<not> negative. countit() will run the loop many times to
217 calculate the speed of CODE before running it for TIME. The actual
218 time run for will usually be greater than TIME due to system clock
219 resolution, so it's best to look at the number of iterations divided
220 by the times that you are concerned with, not just the iterations.
222 Returns: a Benchmark object.
224 =item disablecache ( )
226 Disable caching of timings for the null loop. This will force Benchmark
227 to recalculate these timings for each new piece of code timed.
229 =item enablecache ( )
231 Enable caching of timings for the null loop. The time taken for COUNT
232 rounds of the null loop will be calculated only once for each
233 different COUNT used.
235 =item timesum ( T1, T2 )
237 Returns the sum of two Benchmark times as a Benchmark object suitable
238 for passing to timestr().
244 The data is stored as a list of values from the time and times
247 ($real, $user, $system, $children_user, $children_system, $iters)
249 in seconds for the whole loop (not divided by the number of rounds).
251 The timing is done using time(3) and times(3).
253 Code is executed in the caller's package.
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.
259 The null loop times can be cached, the key being the
260 number of rounds. The caching can be controlled using
269 Caching is off by default, as it can (usually slightly) decrease
270 accuracy and does not usually noticably affect runtimes.
274 Benchmark inherits from no other class, except of course
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.
283 The real time timing is done using time(2) and
284 the granularity is therefore only one second.
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:
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.
298 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
300 =head1 MODIFICATION HISTORY
302 September 8th, 1994; by Tim Bunce.
304 March 28th, 1997; by Hugo van der Sanden: added support for code
305 references and the already documented 'debug' method; revamped
308 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
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()).
317 # evaluate something in a clean lexical environment
318 sub _doeval { eval shift }
321 # put any lexicals at file scope AFTER here
327 @EXPORT=qw(timeit timethis timethese timediff timestr);
328 @EXPORT_OK=qw(timesum cmpthese countit
329 clearcache clearallcache disablecache enablecache);
337 $defaultfmt = '5.2f';
338 $defaultstyle = 'auto';
339 # The cache can cause a slight loss of sys time accuracy. If a
340 # user does many tests (>10) with *very* large counts (>10000)
341 # or works on a very slow machine the cache may be useful.
346 sub debug { $debug = ($_[1] != 0); }
348 # The cache needs two branches: 's' for strings and 'c' for code. The
349 # emtpy loop is different in these two cases.
350 sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
351 sub clearallcache { %cache = (); }
352 sub enablecache { $cache = 1; }
353 sub disablecache { $cache = 0; }
355 # --- Functions to process the 'time' data type
357 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
358 print "new=@t\n" if $debug;
361 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
362 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
363 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
364 sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
365 sub iters { $_[0]->[5] ; }
370 for (my $i=0; $i < @$a; ++$i) {
371 push(@r, $a->[$i] - $b->[$i]);
379 for (my $i=0; $i < @$a; ++$i) {
380 push(@r, $a->[$i] + $b->[$i]);
386 my($tr, $style, $f) = @_;
388 warn "bad time value (@t)" unless @t==6;
389 my($r, $pu, $ps, $cu, $cs, $n) = @t;
390 my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
391 $f = $defaultfmt unless defined $f;
392 # format a time in the required style, other formats may be added here
393 $style ||= $defaultstyle;
394 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
395 my $s = "@t $style"; # default for unknown style
396 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
397 @t,$t) if $style eq 'all';
398 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
399 $r,$pu,$ps,$pt) if $style eq 'noc';
400 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
401 $r,$cu,$cs,$ct) if $style eq 'nop';
402 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
408 print STDERR "$msg",timestr($t),"\n" if $debug;
411 # --- Functions implementing low-level support for timing loops
416 $n+=0; # force numeric now, so garbage won't creep into the eval
417 croak "negative loopcount $n" if $n<0;
418 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
419 my($t0, $t1, $td); # before, after, difference
421 # find package of caller so we can execute code there
422 my($curpack) = caller(0);
424 while (($pack) = caller(++$i)) {
425 last if $pack ne $curpack;
428 my ($subcode, $subref);
429 if (ref $c eq 'CODE') {
430 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
431 $subref = eval $subcode;
434 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
435 $subref = _doeval($subcode);
437 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
438 print STDERR "runloop $n '$subcode'\n" if $debug;
440 # Wait for the user timer to tick. This makes the error range more like
441 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
442 # may not seem important, but it significantly reduces the chances of
443 # getting a too low initial $n in the initial, 'find the minimum' loop
444 # in &countit. This, in turn, can reduce the number of calls to
445 # &runloop a lot, and thus reduce additive errors.
446 my $tbase = Benchmark->new(0)->[1];
447 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
449 $t1 = Benchmark->new($n);
450 $td = &timediff($t1, $t0);
451 timedebug("runloop:",$td);
460 printf STDERR "timeit $n $code\n" if $debug;
461 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
462 if ($cache && exists $cache{$cache_key} ) {
463 $wn = $cache{$cache_key};
465 $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
466 # Can't let our baseline have any iterations, or they get subtracted
469 $cache{$cache_key} = $wn;
472 $wc = &runloop($n, $code);
474 $wd = timediff($wc, $wn);
475 timedebug("timeit: ",$wc);
476 timedebug(" - ",$wn);
477 timedebug(" = ",$wd);
488 my ( $tmax, $code ) = @_;
490 if ( not defined $tmax or $tmax == 0 ) {
491 $tmax = $default_for;
492 } elsif ( $tmax < 0 ) {
496 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
501 # First find the minimum $n that gives a significant timing.
502 for ($n = 1; ; $n *= 2 ) {
503 my $td = timeit($n, $code);
504 $tc = $td->[1] + $td->[2];
510 # Get $n high enough that we can guess the final $n with some accuracy.
511 my $tpra = 0.1 * $tmax; # Target/time practice.
512 while ( $tc < $tpra ) {
513 # The 5% fudge is to keep us from iterating again all
514 # that often (this speeds overall responsiveness when $tmax is big
515 # and we guess a little low). This does not noticably affect
516 # accuracy since we're not couting these times.
517 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
518 my $td = timeit($n, $code);
519 $tc = $td->[1] + $td->[2];
522 # Now, do the 'for real' timing(s), repeating until we exceed
532 # The 5% fudge is because $n is often a few % low even for routines
533 # with stable times and avoiding extra timeit()s is nice for
535 $n = int( $n * ( 1.05 * $tmax / $tc ) );
538 my $td = timeit($n, $code);
545 $ttot = $utot + $stot;
546 last if $ttot >= $tmax;
548 my $r = $tmax / $ttot - 1; # Linear approximation.
549 $n = int( $r * $ntot );
550 $n = $nmin if $n < $nmin;
553 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
556 # --- Functions implementing high-level time-then-print utilities
560 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
564 my($n, $code, $title, $style) = @_;
568 croak "non-integer loopcount $n, stopped" if int($n)<$n;
569 $t = timeit($n, $code);
570 $title = "timethis $n" unless defined $title;
572 $fort = n_to_for( $n );
573 $t = countit( $fort, $code );
574 $title = "timethis for $fort" unless defined $title;
578 $style = "" unless defined $style;
579 printf("%10s: ", $title) unless $style eq 'none';
580 print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
582 $n = $forn if defined $forn;
584 # A conservative warning to spot very silly tests.
585 # Don't assume that your benchmark is ok simply because
586 # you don't get this warning!
587 print " (warning: too few iterations for a reliable count)\n"
589 || ($t->real < 1 && $n < 1000)
590 || $t->cpu_a < $min_cpu;
595 my($n, $alt, $style) = @_;
596 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
597 unless ref $alt eq HASH;
598 my @names = sort keys %$alt;
599 $style = "" unless defined $style;
600 print "Benchmark: " unless $style eq 'none';
602 croak "non-integer loopcount $n, stopped" if int($n)<$n;
603 print "timing $n iterations of" unless $style eq 'none';
605 print "running" unless $style eq 'none';
607 print " ", join(', ',@names) unless $style eq 'none';
609 my $for = n_to_for( $n );
610 print ", each for at least $for CPU seconds" unless $style eq 'none';
612 print "...\n" unless $style eq 'none';
614 # we could save the results in an array and produce a summary here
615 # sum, min, max, avg etc etc
617 foreach my $name (@names) {
618 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
625 my $results = ref $_[0] ? $_[0] : timethese( @_ );
628 if defined $_[2] && $_[2] eq 'none';
630 # Flatten in to an array of arrays with the name as the first field
631 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
634 # The epsilon fudge here is to prevent div by 0. Since clock
635 # resolutions are much larger, it's below the noise floor.
636 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
641 @vals = sort { $a->[7] <=> $b->[7] } @vals;
643 # If more than half of the rates are greater than one...
644 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
651 $display_as_rate ? 'Rate' : 's/iter',
652 map { $_->[0] } @vals
655 push @rows, \@top_row;
656 @col_widths = map { length( $_ ) } @top_row;
658 # Build the data rows
659 # We leave the last column in even though it never has any data. Perhaps
660 # it should go away. Also, perhaps a style for a single column of
661 # percentages might be nice.
662 for my $row_val ( @vals ) {
665 # Column 0 = test name
666 push @row, $row_val->[0];
667 $col_widths[0] = length( $row_val->[0] )
668 if length( $row_val->[0] ) > $col_widths[0];
670 # Column 1 = performance
671 my $row_rate = $row_val->[7];
673 # We assume that we'll never get a 0 rate.
674 my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
676 # Only give a few decimal places before switching to sci. notation,
677 # since the results aren't usually that accurate anyway.
691 # Using $b here due to optimizing bug in _58 through _61
692 my $b = sprintf( $format, $a );
694 $col_widths[1] = length( $b )
695 if length( $b ) > $col_widths[1];
697 # Columns 2..N = performance ratios
699 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
700 my $col_val = $vals[$col_num];
705 elsif ( $col_val->[0] eq $row_val->[0] ) {
710 my $col_rate = $col_val->[7];
711 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
714 $col_widths[$col_num+2] = length( $out )
715 if length( $out ) > $col_widths[$col_num+2];
717 # A little wierdness to set the first column width properly
718 $col_widths[$col_num+2] = length( $col_val->[0] )
719 if length( $col_val->[0] ) > $col_widths[$col_num+2];
724 # Equalize column widths in the chart as much as possible without
725 # exceeding 80 characters. This does not use or affect cols 0 or 1.
726 my @sorted_width_refs =
727 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
728 my $max_width = ${$sorted_width_refs[-1]};
730 my $total = @col_widths - 1 ;
731 for ( @col_widths ) { $total += $_ }
734 while ( $total < 80 ) {
735 my $min_width = ${$sorted_width_refs[0]};
737 if $min_width == $max_width;
738 for ( @sorted_width_refs ) {
749 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
750 substr( $format, 1, 0 ) = '-';