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 timeit - run a chunk of code and see how long it goes
  12
  13 =head1 SYNOPSIS
  14
  15     timethis ($count, "code");
  16
  17     # Use Perl code in strings...
  18     timethese($count, {
  19         'Name1' => '...code1...',
  20         'Name2' => '...code2...',
  21     });
  22
  23     # ... or use subroutine references.
  24     timethese($count, {
  25         'Name1' => sub { ...code1... },
  26         'Name2' => sub { ...code2... },
  27     });
  28
  29     $t = timeit($count, '...other code...')
  30     print "$count loops of other code took:",timestr($t),"\n";
  31
  32 =head1 DESCRIPTION
  33
  34 The Benchmark module encapsulates a number of routines to help you
  35 figure out how long it takes to execute some code.
  36
  37 =head2 Methods
  38
  39 =over 10
  40
  41 =item new
  42
  43 Returns the current time.   Example:
  44
  45     use Benchmark;
  46     $t0 = new Benchmark;
  47     # ... your code here ...
  48     $t1 = new Benchmark;
  49     $td = timediff($t1, $t0);
  50     print "the code took:",timestr($td),"\n";
  51
  52 =item debug
  53
  54 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
  55
  56     debug Benchmark 1;
  57     $t = timeit(10, ' 5 ** $Global ');
  58     debug Benchmark 0;
  59
  60 =back
  61
  62 =head2 Standard Exports
  63
  64 The following routines will be exported into your namespace
  65 if you use the Benchmark module:
  66
  67 =over 10
  68
  69 =item timeit(COUNT, CODE)
  70
  71 Arguments: COUNT is the number of times to run the loop, and CODE is
  72 the code to run.  CODE may be either a code reference or a string to
  73 be eval'd; either way it will be run in the caller's package.
  74
  75 Returns: a Benchmark object.
  76
  77 =item timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] )
  78
  79 Time COUNT iterations of CODE. CODE may be a string to eval or a
  80 code reference; either way the CODE will run in the caller's package.
  81 Results will be printed to STDOUT as TITLE followed by the times.
  82 TITLE defaults to "timethis COUNT" if none is provided. STYLE
  83 determines the format of the output, as described for timestr() below.
  84
  85 The COUNT can be zero or negative: this means the I<minimum number of
  86 CPU seconds> to run.  A zero signifies the default of 3 seconds.  For
  87 example to run at least for 10 seconds:
  88
  89         timethis(-10, $code)
  90
  91 or to run two pieces of code tests for at least 3 seconds:
  92
  93         timethese(0, { test1 => '...', test2 => '...'})
  94
  95 CPU seconds is, in UNIX terms, the user time plus the system time of
  96 the process itself, as opposed to the real (wallclock) time and the
  97 time spent by the child processes.  Less than 0.1 seconds is not
  98 accepted (-0.01 as the count, for example, will cause a fatal runtime
  99 exception).
 100
 101 Note that the CPU seconds is the B<minimum> time: CPU scheduling and
 102 other operating system factors may complicate the attempt so that a
 103 little bit more time is spent.  The benchmark output will, however,
 104 also tell the number of C<$code> runs/second, which should be a more
 105 interesting number than the actually spent seconds.
 106
 107 Returns a Benchmark object.
 108
 109 =item timethese ( COUNT, CODEHASHREF, [ STYLE ] )
 110
 111 The CODEHASHREF is a reference to a hash containing names as keys
 112 and either a string to eval or a code reference for each value.
 113 For each (KEY, VALUE) pair in the CODEHASHREF, this routine will
 114 call
 115
 116         timethis(COUNT, VALUE, KEY, STYLE)
 117
 118 The routines are called in string comparison order of KEY.
 119
 120 The COUNT can be zero or negative, see timethis().
 121
 122 =item timediff ( T1, T2 )
 123
 124 Returns the difference between two Benchmark times as a Benchmark
 125 object suitable for passing to timestr().
 126
 127 =item timesum ( T1, T2 )
 128
 129 Returns the sum of two Benchmark times as a Benchmark object suitable
 130 for passing to timestr().
 131
 132 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
 133
 134 Returns a string that formats the times in the TIMEDIFF object in
 135 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
 136 similar to that returned by timediff().
 137
 138 STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
 139 of the 5 times available ('wallclock' time, user time, system time,
 140 user time of children, and system time of children). 'noc' shows all
 141 except the two children times. 'nop' shows only wallclock and the
 142 two children times. 'auto' (the default) will act as 'all' unless
 143 the children times are both zero, in which case it acts as 'noc'.
 144
 145 FORMAT is the L<printf(3)>-style format specifier (without the
 146 leading '%') to use to print the times. It defaults to '5.2f'.
 147
 148 =back
 149
 150 =head2 Optional Exports
 151
 152 The following routines will be exported into your namespace
 153 if you specifically ask that they be imported:
 154
 155 =over 10
 156
 157 =item clearcache ( COUNT )
 158
 159 Clear the cached time for COUNT rounds of the null loop.
 160
 161 =item clearallcache ( )
 162
 163 Clear all cached times.
 164
 165 =item disablecache ( )
 166
 167 Disable caching of timings for the null loop. This will force Benchmark
 168 to recalculate these timings for each new piece of code timed.
 169
 170 =item enablecache ( )
 171
 172 Enable caching of timings for the null loop. The time taken for COUNT
 173 rounds of the null loop will be calculated only once for each
 174 different COUNT used.
 175
 176 =back
 177
 178 =head1 NOTES
 179
 180 The data is stored as a list of values from the time and times
 181 functions:
 182
 183       ($real, $user, $system, $children_user, $children_system)
 184
 185 in seconds for the whole loop (not divided by the number of rounds).
 186
 187 The timing is done using time(3) and times(3).
 188
 189 Code is executed in the caller's package.
 190
 191 The time of the null loop (a loop with the same
 192 number of rounds but empty loop body) is subtracted
 193 from the time of the real loop.
 194
 195 The null loop times are cached, the key being the
 196 number of rounds. The caching can be controlled using
 197 calls like these:
 198
 199     clearcache($key);
 200     clearallcache();
 201
 202     disablecache();
 203     enablecache();
 204
 205 =head1 INHERITANCE
 206
 207 Benchmark inherits from no other class, except of course
 208 for Exporter.
 209
 210 =head1 CAVEATS
 211
 212 Comparing eval'd strings with code references will give you
 213 inaccurate results: a code reference will show a slower
 214 execution time than the equivalent eval'd string.
 215
 216 The real time timing is done using time(2) and
 217 the granularity is therefore only one second.
 218
 219 Short tests may produce negative figures because perl
 220 can appear to take longer to execute the empty loop
 221 than a short test; try:
 222
 223     timethis(100,'1');
 224
 225 The system time of the null loop might be slightly
 226 more than the system time of the loop with the actual
 227 code and therefore the difference might end up being E<lt> 0.
 228
 229 =head1 AUTHORS
 230
 231 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 232
 233 =head1 MODIFICATION HISTORY
 234
 235 September 8th, 1994; by Tim Bunce.
 236
 237 March 28th, 1997; by Hugo van der Sanden: added support for code
 238 references and the already documented 'debug' method; revamped
 239 documentation.
 240
 241 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 242 functionality.
 243
 244 =cut
 245
 246 # evaluate something in a clean lexical environment
 247 sub _doeval { eval shift }
 248
 249 #
 250 # put any lexicals at file scope AFTER here
 251 #
 252
 253 use Carp;
 254 use Exporter;
 255 @ISA=(Exporter);
 256 @EXPORT=qw(timeit timethis timethese timediff timesum timestr);
 257 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
 258
 259 &init;
 260
 261 sub init {
 262     $debug = 0;
 263     $min_count = 4;
 264     $min_cpu   = 0.4;
 265     $defaultfmt = '5.2f';
 266     $defaultstyle = 'auto';
 267     # The cache can cause a slight loss of sys time accuracy. If a
 268     # user does many tests (>10) with *very* large counts (>10000)
 269     # or works on a very slow machine the cache may be useful.
 270     &disablecache;
 271     &clearallcache;
 272 }
 273
 274 sub debug { $debug = ($_[1] != 0); }
 275
 276 # The cache needs two branches: 's' for strings and 'c' for code.  The
 277 # emtpy loop is different in these two cases.
 278 sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
 279 sub clearallcache { %cache = (); }
 280 sub enablecache   { $cache = 1; }
 281 sub disablecache  { $cache = 0; }
 282
 283 # --- Functions to process the 'time' data type
 284
 285 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
 286           print "new=@t\n" if $debug;
 287           bless \@t; }
 288
 289 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 290 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 291 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 292 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 293
 294 sub timediff {
 295     my($a, $b) = @_;
 296     my @r;
 297     for (my $i=0; $i < @$a; ++$i) {
 298         push(@r, $a->[$i] - $b->[$i]);
 299     }
 300     bless \@r;
 301 }
 302
 303 sub timesum {
 304      my($a, $b) = @_;
 305      my @r;
 306      for (my $i=0; $i < @$a; ++$i) {
 307         push(@r, $a->[$i] + $b->[$i]);
 308      }
 309      bless \@r;
 310 }
 311
 312 sub timestr {
 313     my($tr, $style, $f) = @_;
 314     my @t = @$tr;
 315     warn "bad time value (@t)" unless @t==6;
 316     my($r, $pu, $ps, $cu, $cs, $n) = @t;
 317     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 318     $f = $defaultfmt unless defined $f;
 319     # format a time in the required style, other formats may be added here
 320     $style ||= $defaultstyle;
 321     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 322     my $s = "@t $style"; # default for unknown style
 323     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
 324                             @t,$t) if $style eq 'all';
 325     $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
 326                             $r,$pu,$ps,$pt) if $style eq 'noc';
 327     $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
 328                             $r,$cu,$cs,$ct) if $style eq 'nop';
 329     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
 330     $s;
 331 }
 332
 333 sub timedebug {
 334     my($msg, $t) = @_;
 335     print STDERR "$msg",timestr($t),"\n" if $debug;
 336 }
 337
 338 # --- Functions implementing low-level support for timing loops
 339
 340 sub runloop {
 341     my($n, $c) = @_;
 342
 343     $n+=0; # force numeric now, so garbage won't creep into the eval
 344     croak "negative loopcount $n" if $n<0;
 345     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 346     my($t0, $t1, $td); # before, after, difference
 347
 348     # find package of caller so we can execute code there
 349     my($curpack) = caller(0);
 350     my($i, $pack)= 0;
 351     while (($pack) = caller(++$i)) {
 352         last if $pack ne $curpack;
 353     }
 354
 355     my ($subcode, $subref);
 356     if (ref $c eq 'CODE') {
 357         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
 358         $subref  = eval $subcode;
 359     }
 360     else {
 361         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
 362         $subref  = _doeval($subcode);
 363     }
 364     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 365     print STDERR "runloop $n '$subcode'\n" if $debug;
 366
 367     # Wait for the user timer to tick.  This makes the error range more like -0.01, +0.  If
 368     # we don't wait, then it's more like -0.01, +0.01.  This may not seem important, but it
 369     # significantly reduces the chances of getting too low initial $n in the initial, 'find
 370     # the minimum' loop in &runfor.  This, in turn, can reduce the number of calls to
 371     # &runloop a lot, and thus reduce additive errors.
 372     my $tbase = Benchmark->new(0)->[1];
 373     do {
 374        $t0 = Benchmark->new(0);
 375     } while ( $t0->[1] == $tbase ) ;
 376     &$subref;
 377     $t1 = Benchmark->new($n);
 378     $td = &timediff($t1, $t0);
 379     timedebug("runloop:",$td);
 380     $td;
 381 }
 382
 383
 384 sub timeit {
 385     my($n, $code) = @_;
 386     my($wn, $wc, $wd);
 387
 388     printf STDERR "timeit $n $code\n" if $debug;
 389     my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ) ;
 390     if ($cache && exists $cache{$cache_key} ) {
 391         $wn = $cache{$cache_key};
 392     } else {
 393         $wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
 394         $cache{$cache_key} = $wn;
 395     }
 396
 397     $wc = &runloop($n, $code);
 398
 399     $wd = timediff($wc, $wn);
 400
 401     timedebug("timeit: ",$wc);
 402     timedebug("      - ",$wn);
 403     timedebug("      = ",$wd);
 404
 405     $wd;
 406 }
 407
 408
 409 my $default_for = 3;
 410 my $min_for     = 0.1;
 411
 412 sub runfor {
 413     my ($code, $tmax) = @_;
 414
 415     if ( not defined $tmax or $tmax == 0 ) {
 416         $tmax = $default_for;
 417     } elsif ( $tmax < 0 ) {
 418         $tmax = -$tmax;
 419     }
 420
 421     die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
 422         if $tmax < $min_for;
 423
 424     my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
 425
 426     # First find the minimum $n that gives a significant timing.
 427
 428     my $nmin;
 429
 430     for ($n = 1, $tc = 0; ; $n *= 2 ) {
 431         $td = timeit($n, $code);
 432         $tc = $td->[1] + $td->[2];
 433         last if $tc > 0.1 ;
 434     }
 435
 436     $nmin = $n;
 437
 438     my $ttot = 0;
 439     my $tpra = 0.05 * $tmax; # Target/time practice.
 440     # Double $n until we have think we have practiced enough.
 441     for ( ; $ttot < $tpra; $n *= 2 ) {
 442         $td = timeit($n, $code);
 443         $ntot += $n;
 444         $rtot += $td->[0];
 445         $utot += $td->[1];
 446         $stot += $td->[2];
 447         $ttot = $utot + $stot;
 448         $cutot += $td->[3];
 449         $cstot += $td->[4];
 450     }
 451
 452     my $r;
 453
 454     # Then iterate towards the $tmax.
 455     while ( $ttot < $tmax ) {
 456         $r = $tmax / $ttot - 1; # Linear approximation.
 457         $n = int( $r * $ntot );
 458         $n = $nmin if $n < $nmin;
 459         $td = timeit($n, $code);
 460         $ntot += $n;
 461         $rtot += $td->[0];
 462         $utot += $td->[1];
 463         $stot += $td->[2];
 464         $ttot = $utot + $stot;
 465         $cutot += $td->[3];
 466         $cstot += $td->[4];
 467     }
 468
 469     return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
 470 }
 471
 472 # --- Functions implementing high-level time-then-print utilities
 473
 474 sub n_to_for {
 475     my $n = shift;
 476     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 477 }
 478
 479 sub timethis{
 480     my($n, $code, $title, $style) = @_;
 481     my($t, $for, $forn);
 482
 483     if ( $n > 0 ) {
 484         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 485         $t = timeit($n, $code);
 486         $title = "timethis $n" unless defined $title;
 487     } else {
 488         $fort  = n_to_for( $n );
 489         $t     = runfor($code, $fort);
 490         $title = "timethis for $fort" unless defined $title;
 491         $forn  = $t->[-1];
 492     }
 493     local $| = 1;
 494     $style = "" unless defined $style;
 495     printf("%10s: ", $title);
 496     print timestr($t, $style, $defaultfmt),"\n";
 497
 498     $n = $forn if defined $forn;
 499
 500     # A conservative warning to spot very silly tests.
 501     # Don't assume that your benchmark is ok simply because
 502     # you don't get this warning!
 503     print "            (warning: too few iterations for a reliable count)\n"
 504         if     $n < $min_count
 505             || ($t->real < 1 && $n < 1000)
 506             || $t->cpu_a < $min_cpu;
 507     $t;
 508 }
 509
 510 sub timethese{
 511     my($n, $alt, $style) = @_;
 512     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 513                 unless ref $alt eq HASH;
 514     my @names = sort keys %$alt;
 515     $style = "" unless defined $style;
 516     print "Benchmark: ";
 517     if ( $n > 0 ) {
 518         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 519         print "timing $n iterations of";
 520     } else {
 521         print "running";
 522     }
 523     print " ", join(', ',@names);
 524     unless ( $n > 0 ) {
 525         my $for = n_to_for( $n );
 526         print ", each for at least $for CPU seconds";
 527     }
 528     print "...\n";
 529
 530     # we could save the results in an array and produce a summary here
 531     # sum, min, max, avg etc etc
 532     foreach my $name (@names) {
 533         timethis ($n, $alt -> {$name}, $name, $style);
 534     }
 535 }
 536
 537 1;