5 Benchmark - benchmark running times of Perl code
9 use Benchmark qw(:all) ;
11 timethis ($count, "code");
13 # Use Perl code in strings...
15 'Name1' => '...code1...',
16 'Name2' => '...code2...',
19 # ... or use subroutine references.
21 'Name1' => sub { ...code1... },
22 'Name2' => sub { ...code2... },
25 # cmpthese can be used both ways as well
27 'Name1' => '...code1...',
28 'Name2' => '...code2...',
32 'Name1' => sub { ...code1... },
33 'Name2' => sub { ...code2... },
37 $results = timethese($count,
39 'Name1' => sub { ...code1... },
40 'Name2' => sub { ...code2... },
44 cmpthese( $results ) ;
46 $t = timeit($count, '...other code...')
47 print "$count loops of other code took:",timestr($t),"\n";
49 $t = countit($time, '...other code...')
51 print "$count loops of other code took:",timestr($t),"\n";
55 The Benchmark module encapsulates a number of routines to help you
56 figure out how long it takes to execute some code.
58 timethis - run a chunk of code several times
60 timethese - run several chunks of code several times
62 cmpthese - print results of timethese as a comparison chart
64 timeit - run a chunk of code and see how long it goes
66 countit - see how many times a chunk of code runs in a given time
75 Returns the current time. Example:
79 # ... your code here ...
81 $td = timediff($t1, $t0);
82 print "the code took:",timestr($td),"\n";
86 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
89 $t = timeit(10, ' 5 ** $Global ');
94 Returns the number of iterations.
98 =head2 Standard Exports
100 The following routines will be exported into your namespace
101 if you use the Benchmark module:
105 =item timeit(COUNT, CODE)
107 Arguments: COUNT is the number of times to run the loop, and CODE is
108 the code to run. CODE may be either a code reference or a string to
109 be eval'd; either way it will be run in the caller's package.
111 Returns: a Benchmark object.
113 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
115 Time COUNT iterations of CODE. CODE may be a string to eval or a
116 code reference; either way the CODE will run in the caller's package.
117 Results will be printed to STDOUT as TITLE followed by the times.
118 TITLE defaults to "timethis COUNT" if none is provided. STYLE
119 determines the format of the output, as described for timestr() below.
121 The COUNT can be zero or negative: this means the I<minimum number of
122 CPU seconds> to run. A zero signifies the default of 3 seconds. For
123 example to run at least for 10 seconds:
127 or to run two pieces of code tests for at least 3 seconds:
129 timethese(0, { test1 => '...', test2 => '...'})
131 CPU seconds is, in UNIX terms, the user time plus the system time of
132 the process itself, as opposed to the real (wallclock) time and the
133 time spent by the child processes. Less than 0.1 seconds is not
134 accepted (-0.01 as the count, for example, will cause a fatal runtime
137 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
138 other operating system factors may complicate the attempt so that a
139 little bit more time is spent. The benchmark output will, however,
140 also tell the number of C<$code> runs/second, which should be a more
141 interesting number than the actually spent seconds.
143 Returns a Benchmark object.
145 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
147 The CODEHASHREF is a reference to a hash containing names as keys
148 and either a string to eval or a code reference for each value.
149 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
152 timethis(COUNT, VALUE, KEY, STYLE)
154 The routines are called in string comparison order of KEY.
156 The COUNT can be zero or negative, see timethis().
158 Returns a hash of Benchmark objects, keyed by name.
160 =item timediff ( T1, T2 )
162 Returns the difference between two Benchmark times as a Benchmark
163 object suitable for passing to timestr().
165 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
167 Returns a string that formats the times in the TIMEDIFF object in
168 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
169 similar to that returned by timediff().
171 STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows
172 each of the 5 times available ('wallclock' time, user time, system time,
173 user time of children, and system time of children). 'noc' shows all
174 except the two children times. 'nop' shows only wallclock and the
175 two children times. 'auto' (the default) will act as 'all' unless
176 the children times are both zero, in which case it acts as 'noc'.
177 'none' prevents output.
179 FORMAT is the L<printf(3)>-style format specifier (without the
180 leading '%') to use to print the times. It defaults to '5.2f'.
184 =head2 Optional Exports
186 The following routines will be exported into your namespace
187 if you specifically ask that they be imported:
191 =item clearcache ( COUNT )
193 Clear the cached time for COUNT rounds of the null loop.
195 =item clearallcache ( )
197 Clear all cached times.
199 =item cmpthese ( COUNT, CODEHASHREF, [ STYLE ] )
201 =item cmpthese ( RESULTSHASHREF, [ STYLE ] )
203 Optionally calls timethese(), then outputs comparison chart. This:
205 cmpthese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
207 outputs a chart like:
213 This chart is sorted from slowest to fastest, and shows the percent speed
214 difference between each pair of tests.
216 c<cmpthese> can also be passed the data structure that timethese() returns:
218 $results = timethese( -1, { a => "++\$i", b => "\$i *= 2" } ) ;
219 cmpthese( $results );
221 in case you want to see both sets of results.
223 Returns a reference to an ARRAY of rows, each row is an ARRAY of cells from the
224 above chart, including labels. This:
226 my $rows = cmpthese( -1, { a => '++$i', b => '$i *= 2' }, "none" );
228 returns a data structure like:
231 [ '', 'Rate', 'b', 'a' ],
232 [ 'b', '2885232/s', '--', '-59%' ],
233 [ 'a', '7099126/s', '146%', '--' ],
236 B<NOTE>: This result value differs from previous versions, which returned
237 the C<timethese()> result structure. If you want that, just use the two
238 statement C<timethese>...C<cmpthese> idiom shown above.
240 Incidently, note the variance in the result values between the two examples;
241 this is typical of benchmarking. If this were a real benchmark, you would
242 probably want to run a lot more iterations.
244 =item countit(TIME, CODE)
246 Arguments: TIME is the minimum length of time to run CODE for, and CODE is
247 the code to run. CODE may be either a code reference or a string to
248 be eval'd; either way it will be run in the caller's package.
250 TIME is I<not> negative. countit() will run the loop many times to
251 calculate the speed of CODE before running it for TIME. The actual
252 time run for will usually be greater than TIME due to system clock
253 resolution, so it's best to look at the number of iterations divided
254 by the times that you are concerned with, not just the iterations.
256 Returns: a Benchmark object.
258 =item disablecache ( )
260 Disable caching of timings for the null loop. This will force Benchmark
261 to recalculate these timings for each new piece of code timed.
263 =item enablecache ( )
265 Enable caching of timings for the null loop. The time taken for COUNT
266 rounds of the null loop will be calculated only once for each
267 different COUNT used.
269 =item timesum ( T1, T2 )
271 Returns the sum of two Benchmark times as a Benchmark object suitable
272 for passing to timestr().
278 The data is stored as a list of values from the time and times
281 ($real, $user, $system, $children_user, $children_system, $iters)
283 in seconds for the whole loop (not divided by the number of rounds).
285 The timing is done using time(3) and times(3).
287 Code is executed in the caller's package.
289 The time of the null loop (a loop with the same
290 number of rounds but empty loop body) is subtracted
291 from the time of the real loop.
293 The null loop times can be cached, the key being the
294 number of rounds. The caching can be controlled using
303 Caching is off by default, as it can (usually slightly) decrease
304 accuracy and does not usually noticably affect runtimes.
310 use Benchmark qw( cmpthese ) ;
317 outputs something like this:
319 Benchmark: running a, b, each for at least 5 CPU seconds...
327 use Benchmark qw( timethese cmpthese ) ;
329 $r = timethese( -5, {
335 outputs something like this:
337 Benchmark: running a, b, each for at least 5 CPU seconds...
338 a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743)
339 b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452)
347 Benchmark inherits from no other class, except of course
352 Comparing eval'd strings with code references will give you
353 inaccurate results: a code reference will show a slightly slower
354 execution time than the equivalent eval'd string.
356 The real time timing is done using time(2) and
357 the granularity is therefore only one second.
359 Short tests may produce negative figures because perl
360 can appear to take longer to execute the empty loop
361 than a short test; try:
365 The system time of the null loop might be slightly
366 more than the system time of the loop with the actual
367 code and therefore the difference might end up being E<lt> 0.
371 L<Devel::DProf> - a Perl code profiler
375 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
377 =head1 MODIFICATION HISTORY
379 September 8th, 1994; by Tim Bunce.
381 March 28th, 1997; by Hugo van der Sanden: added support for code
382 references and the already documented 'debug' method; revamped
385 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
388 September, 1999; by Barrie Slaymaker: math fixes and accuracy and
389 efficiency tweaks. Added cmpthese(). A result is now returned from
390 timethese(). Exposed countit() (was runfor()).
392 December, 2001; by Nicholas Clark: make timestr() recognise the style 'none'
393 and return an empty string. If cmpthese is calling timethese, make it pass the
394 style in. (so that 'none' will suppress output). Make sub new dump its
395 debugging output to STDERR, to be consistent with everything else.
396 All bugs found while writing a regression test.
400 # evaluate something in a clean lexical environment
401 sub _doeval { eval shift }
404 # put any lexicals at file scope AFTER here
410 @EXPORT=qw(timeit timethis timethese timediff timestr);
411 @EXPORT_OK=qw(timesum cmpthese countit
412 clearcache clearallcache disablecache enablecache);
413 %EXPORT_TAGS=( all => [ @EXPORT, @EXPORT_OK ] ) ;
423 $defaultfmt = '5.2f';
424 $defaultstyle = 'auto';
425 # The cache can cause a slight loss of sys time accuracy. If a
426 # user does many tests (>10) with *very* large counts (>10000)
427 # or works on a very slow machine the cache may be useful.
432 sub debug { $debug = ($_[1] != 0); }
434 # The cache needs two branches: 's' for strings and 'c' for code. The
435 # emtpy loop is different in these two cases.
436 sub clearcache { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
437 sub clearallcache { %cache = (); }
438 sub enablecache { $cache = 1; }
439 sub disablecache { $cache = 0; }
441 # --- Functions to process the 'time' data type
443 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
444 print STDERR "new=@t\n" if $debug;
447 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; }
448 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; }
449 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
450 sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; }
451 sub iters { $_[0]->[5] ; }
456 for (my $i=0; $i < @$a; ++$i) {
457 push(@r, $a->[$i] - $b->[$i]);
465 for (my $i=0; $i < @$a; ++$i) {
466 push(@r, $a->[$i] + $b->[$i]);
472 my($tr, $style, $f) = @_;
474 warn "bad time value (@t)" unless @t==6;
475 my($r, $pu, $ps, $cu, $cs, $n) = @t;
476 my($pt, $ct, $tt) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
477 $f = $defaultfmt unless defined $f;
478 # format a time in the required style, other formats may be added here
479 $style ||= $defaultstyle;
480 return '' if $style eq 'none';
481 $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
482 my $s = "@t $style"; # default for unknown style
483 $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
484 $r,$pu,$ps,$cu,$cs,$tt) if $style eq 'all';
485 $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
486 $r,$pu,$ps,$pt) if $style eq 'noc';
487 $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
488 $r,$cu,$cs,$ct) if $style eq 'nop';
489 $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n && $pu+$ps;
495 print STDERR "$msg",timestr($t),"\n" if $debug;
498 # --- Functions implementing low-level support for timing loops
503 $n+=0; # force numeric now, so garbage won't creep into the eval
504 croak "negative loopcount $n" if $n<0;
505 confess "Usage: runloop(number, [string | coderef])" unless defined $c;
506 my($t0, $t1, $td); # before, after, difference
508 # find package of caller so we can execute code there
509 my($curpack) = caller(0);
511 while (($pack) = caller(++$i)) {
512 last if $pack ne $curpack;
515 my ($subcode, $subref);
516 if (ref $c eq 'CODE') {
517 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
518 $subref = eval $subcode;
521 $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
522 $subref = _doeval($subcode);
524 croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
525 print STDERR "runloop $n '$subcode'\n" if $debug;
527 # Wait for the user timer to tick. This makes the error range more like
528 # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This
529 # may not seem important, but it significantly reduces the chances of
530 # getting a too low initial $n in the initial, 'find the minimum' loop
531 # in &countit. This, in turn, can reduce the number of calls to
532 # &runloop a lot, and thus reduce additive errors.
533 my $tbase = Benchmark->new(0)->[1];
534 while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ;
536 $t1 = Benchmark->new($n);
537 $td = &timediff($t1, $t0);
538 timedebug("runloop:",$td);
547 printf STDERR "timeit $n $code\n" if $debug;
548 my $cache_key = $n . ( ref( $code ) ? 'c' : 's' );
549 if ($cache && exists $cache{$cache_key} ) {
550 $wn = $cache{$cache_key};
552 $wn = &runloop($n, ref( $code ) ? sub { } : '' );
553 # Can't let our baseline have any iterations, or they get subtracted
556 $cache{$cache_key} = $wn;
559 $wc = &runloop($n, $code);
561 $wd = timediff($wc, $wn);
562 timedebug("timeit: ",$wc);
563 timedebug(" - ",$wn);
564 timedebug(" = ",$wd);
575 my ( $tmax, $code ) = @_;
577 if ( not defined $tmax or $tmax == 0 ) {
578 $tmax = $default_for;
579 } elsif ( $tmax < 0 ) {
583 die "countit($tmax, ...): timelimit cannot be less than $min_for.\n"
588 # First find the minimum $n that gives a significant timing.
589 for ($n = 1; ; $n *= 2 ) {
590 my $td = timeit($n, $code);
591 $tc = $td->[1] + $td->[2];
597 # Get $n high enough that we can guess the final $n with some accuracy.
598 my $tpra = 0.1 * $tmax; # Target/time practice.
599 while ( $tc < $tpra ) {
600 # The 5% fudge is to keep us from iterating again all
601 # that often (this speeds overall responsiveness when $tmax is big
602 # and we guess a little low). This does not noticably affect
603 # accuracy since we're not couting these times.
604 $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation.
605 my $td = timeit($n, $code);
606 my $new_tc = $td->[1] + $td->[2];
607 # Make sure we are making progress.
608 $tc = $new_tc > 1.2 * $tc ? $new_tc : 1.2 * $tc;
611 # Now, do the 'for real' timing(s), repeating until we exceed
621 # The 5% fudge is because $n is often a few % low even for routines
622 # with stable times and avoiding extra timeit()s is nice for
624 $n = int( $n * ( 1.05 * $tmax / $tc ) );
627 my $td = timeit($n, $code);
634 $ttot = $utot + $stot;
635 last if $ttot >= $tmax;
637 $ttot = 0.01 if $ttot < 0.01;
638 my $r = $tmax / $ttot - 1; # Linear approximation.
639 $n = int( $r * $ntot );
640 $n = $nmin if $n < $nmin;
643 return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
646 # --- Functions implementing high-level time-then-print utilities
650 return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
654 my($n, $code, $title, $style) = @_;
658 croak "non-integer loopcount $n, stopped" if int($n)<$n;
659 $t = timeit($n, $code);
660 $title = "timethis $n" unless defined $title;
662 $fort = n_to_for( $n );
663 $t = countit( $fort, $code );
664 $title = "timethis for $fort" unless defined $title;
668 $style = "" unless defined $style;
669 printf("%10s: ", $title) unless $style eq 'none';
670 print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none';
672 $n = $forn if defined $forn;
674 # A conservative warning to spot very silly tests.
675 # Don't assume that your benchmark is ok simply because
676 # you don't get this warning!
677 print " (warning: too few iterations for a reliable count)\n"
679 || ($t->real < 1 && $n < 1000)
680 || $t->cpu_a < $min_cpu;
685 my($n, $alt, $style) = @_;
686 die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
687 unless ref $alt eq HASH;
688 my @names = sort keys %$alt;
689 $style = "" unless defined $style;
690 print "Benchmark: " unless $style eq 'none';
692 croak "non-integer loopcount $n, stopped" if int($n)<$n;
693 print "timing $n iterations of" unless $style eq 'none';
695 print "running" unless $style eq 'none';
697 print " ", join(', ',@names) unless $style eq 'none';
699 my $for = n_to_for( $n );
700 print ", each" if $n > 1 && $style ne 'none';
701 print " for at least $for CPU seconds" unless $style eq 'none';
703 print "...\n" unless $style eq 'none';
705 # we could save the results in an array and produce a summary here
706 # sum, min, max, avg etc etc
708 foreach my $name (@names) {
709 $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
716 my ($results, $style) =
718 : (timethese (@_ [0, 1], @_ > 2 ? $_ [2] : "none"), $_ [2]);
720 $style = "" unless defined $style;
722 # Flatten in to an array of arrays with the name as the first field
723 my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
726 # The epsilon fudge here is to prevent div by 0. Since clock
727 # resolutions are much larger, it's below the noise floor.
728 my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 );
733 @vals = sort { $a->[7] <=> $b->[7] } @vals;
735 # If more than half of the rates are greater than one...
736 my $display_as_rate = $vals[$#vals>>1]->[7] > 1;
743 $display_as_rate ? 'Rate' : 's/iter',
744 map { $_->[0] } @vals
747 push @rows, \@top_row;
748 @col_widths = map { length( $_ ) } @top_row;
750 # Build the data rows
751 # We leave the last column in even though it never has any data. Perhaps
752 # it should go away. Also, perhaps a style for a single column of
753 # percentages might be nice.
754 for my $row_val ( @vals ) {
757 # Column 0 = test name
758 push @row, $row_val->[0];
759 $col_widths[0] = length( $row_val->[0] )
760 if length( $row_val->[0] ) > $col_widths[0];
762 # Column 1 = performance
763 my $row_rate = $row_val->[7];
765 # We assume that we'll never get a 0 rate.
766 my $a = $display_as_rate ? $row_rate : 1 / $row_rate;
768 # Only give a few decimal places before switching to sci. notation,
769 # since the results aren't usually that accurate anyway.
783 # Using $b here due to optimizing bug in _58 through _61
784 my $b = sprintf( $format, $a );
786 $col_widths[1] = length( $b )
787 if length( $b ) > $col_widths[1];
789 # Columns 2..N = performance ratios
791 for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
792 my $col_val = $vals[$col_num];
797 elsif ( $col_val->[0] eq $row_val->[0] ) {
802 my $col_rate = $col_val->[7];
803 $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
806 $col_widths[$col_num+2] = length( $out )
807 if length( $out ) > $col_widths[$col_num+2];
809 # A little wierdness to set the first column width properly
810 $col_widths[$col_num+2] = length( $col_val->[0] )
811 if length( $col_val->[0] ) > $col_widths[$col_num+2];
816 return \@rows if $style eq "none";
818 # Equalize column widths in the chart as much as possible without
819 # exceeding 80 characters. This does not use or affect cols 0 or 1.
820 my @sorted_width_refs =
821 sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
822 my $max_width = ${$sorted_width_refs[-1]};
824 my $total = @col_widths - 1 ;
825 for ( @col_widths ) { $total += $_ }
828 while ( $total < 80 ) {
829 my $min_width = ${$sorted_width_refs[0]};
831 if $min_width == $max_width;
832 for ( @sorted_width_refs ) {
843 my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
844 substr( $format, 1, 0 ) = '-';