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 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 sub clearcache    { delete $cache{$_[0]}; }
 277 sub clearallcache { %cache = (); }
 278 sub enablecache   { $cache = 1; }
 279 sub disablecache  { $cache = 0; }
 280
 281 # --- Functions to process the 'time' data type
 282
 283 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
 284           print "new=@t\n" if $debug;
 285           bless \@t; }
 286
 287 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 288 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 289 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 290 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 291
 292 sub timediff {
 293     my($a, $b) = @_;
 294     my @r;
 295     for (my $i=0; $i < @$a; ++$i) {
 296         push(@r, $a->[$i] - $b->[$i]);
 297     }
 298     bless \@r;
 299 }
 300
 301 sub timesum {
 302      my($a, $b) = @_;
 303      my @r;
 304      for (my $i=0; $i < @$a; ++$i) {
 305         push(@r, $a->[$i] + $b->[$i]);
 306      }
 307      bless \@r;
 308 }
 309
 310 sub timestr {
 311     my($tr, $style, $f) = @_;
 312     my @t = @$tr;
 313     warn "bad time value (@t)" unless @t==6;
 314     my($r, $pu, $ps, $cu, $cs, $n) = @t;
 315     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 316     $f = $defaultfmt unless defined $f;
 317     # format a time in the required style, other formats may be added here
 318     $style ||= $defaultstyle;
 319     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 320     my $s = "@t $style"; # default for unknown style
 321     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU)",
 322                             @t,$t) if $style eq 'all';
 323     $s=sprintf("%2d wallclock secs (%$f usr + %$f sys = %$f CPU)",
 324                             $r,$pu,$ps,$pt) if $style eq 'noc';
 325     $s=sprintf("%2d wallclock secs (%$f cusr + %$f csys = %$f CPU)",
 326                             $r,$cu,$cs,$ct) if $style eq 'nop';
 327     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
 328     $s;
 329 }
 330
 331 sub timedebug {
 332     my($msg, $t) = @_;
 333     print STDERR "$msg",timestr($t),"\n" if $debug;
 334 }
 335
 336 # --- Functions implementing low-level support for timing loops
 337
 338 sub runloop {
 339     my($n, $c) = @_;
 340
 341     $n+=0; # force numeric now, so garbage won't creep into the eval
 342     croak "negative loopcount $n" if $n<0;
 343     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 344     my($t0, $t1, $td); # before, after, difference
 345
 346     # find package of caller so we can execute code there
 347     my($curpack) = caller(0);
 348     my($i, $pack)= 0;
 349     while (($pack) = caller(++$i)) {
 350         last if $pack ne $curpack;
 351     }
 352
 353     my ($subcode, $subref);
 354     if (ref $c eq 'CODE') {
 355         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; &\$c; } }";
 356         $subref  = eval $subcode;
 357     }
 358     else {
 359         $subcode = "sub { for (1 .. $n) { local \$_; package $pack; $c;} }";
 360         $subref  = _doeval($subcode);
 361     }
 362     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 363     print STDERR "runloop $n '$subcode'\n" if $debug;
 364
 365     $t0 = Benchmark->new(0);
 366     &$subref;
 367     $t1 = Benchmark->new($n);
 368     $td = &timediff($t1, $t0);
 369
 370     timedebug("runloop:",$td);
 371     $td;
 372 }
 373
 374
 375 sub timeit {
 376     my($n, $code) = @_;
 377     my($wn, $wc, $wd);
 378
 379     printf STDERR "timeit $n $code\n" if $debug;
 380
 381     if ($cache && exists $cache{$n}) {
 382         $wn = $cache{$n};
 383     } else {
 384         $wn = &runloop($n, '');
 385         $cache{$n} = $wn;
 386     }
 387
 388     $wc = &runloop($n, $code);
 389
 390     $wd = timediff($wc, $wn);
 391
 392     timedebug("timeit: ",$wc);
 393     timedebug("      - ",$wn);
 394     timedebug("      = ",$wd);
 395
 396     $wd;
 397 }
 398
 399
 400 my $default_for = 3;
 401 my $min_for     = 0.1;
 402
 403 sub runfor {
 404     my ($code, $tmax) = @_;
 405
 406     if ( not defined $tmax or $tmax == 0 ) {
 407         $tmax = $default_for;
 408     } elsif ( $tmax < 0 ) {
 409         $tmax = -$tmax;
 410     }
 411
 412     die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
 413         if $tmax < $min_for;
 414
 415     my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
 416
 417     # First find the minimum $n that gives a non-zero timing.
 418
 419     my $nmin;
 420
 421     for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
 422         $td = timeit($n, $code);
 423         $tc = $td->[1] + $td->[2];
 424     }
 425
 426     $nmin = $n;
 427
 428     my $ttot = 0;
 429     my $tpra = 0.05 * $tmax; # Target/time practice.
 430
 431     # Double $n until we have think we have practiced enough.
 432     for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
 433         $td = timeit($n, $code);
 434         $tc = $td->cpu_p;
 435         $ntot += $n;
 436         $rtot += $td->[0];
 437         $utot += $td->[1];
 438         $stot += $td->[2];
 439         $ttot = $utot + $stot;
 440         $cutot += $td->[3];
 441         $cstot += $td->[4];
 442     }
 443
 444     my $r;
 445
 446     # Then iterate towards the $tmax.
 447     while ( $ttot < $tmax ) {
 448         $r = $tmax / $ttot - 1; # Linear approximation.
 449         $n = int( $r * $n );
 450         $n = $nmin if $n < $nmin;
 451         $td = timeit($n, $code);
 452         $ntot += $n;
 453         $rtot += $td->[0];
 454         $utot += $td->[1];
 455         $stot += $td->[2];
 456         $ttot = $utot + $stot;
 457         $cutot += $td->[3];
 458         $cstot += $td->[4];
 459     }
 460
 461     return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
 462 }
 463
 464 # --- Functions implementing high-level time-then-print utilities
 465
 466 sub n_to_for {
 467     my $n = shift;
 468     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 469 }
 470
 471 sub timethis{
 472     my($n, $code, $title, $style) = @_;
 473     my($t, $for, $forn);
 474
 475     if ( $n > 0 ) {
 476         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 477         $t = timeit($n, $code);
 478         $title = "timethis $n" unless defined $title;
 479     } else {
 480         $fort  = n_to_for( $n );
 481         $t     = runfor($code, $fort);
 482         $title = "timethis for $fort" unless defined $title;
 483         $forn  = $t->[-1];
 484     }
 485     local $| = 1;
 486     $style = "" unless defined $style;
 487     printf("%10s: ", $title);
 488     print timestr($t, $style, $defaultfmt),"\n";
 489
 490     $n = $forn if defined $forn;
 491
 492     # A conservative warning to spot very silly tests.
 493     # Don't assume that your benchmark is ok simply because
 494     # you don't get this warning!
 495     print "            (warning: too few iterations for a reliable count)\n"
 496         if     $n < $min_count
 497             || ($t->real < 1 && $n < 1000)
 498             || $t->cpu_a < $min_cpu;
 499     $t;
 500 }
 501
 502 sub timethese{
 503     my($n, $alt, $style) = @_;
 504     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 505                 unless ref $alt eq HASH;
 506     my @names = sort keys %$alt;
 507     $style = "" unless defined $style;
 508     print "Benchmark: ";
 509     if ( $n > 0 ) {
 510         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 511         print "timing $n iterations of";
 512     } else {
 513         print "running";
 514     }
 515     print " ", join(', ',@names);
 516     unless ( $n > 0 ) {
 517         my $for = n_to_for( $n );
 518         print ", each for at least $for CPU seconds";
 519     }
 520     print "...\n";
 521
 522     # we could save the results in an array and produce a summary here
 523     # sum, min, max, avg etc etc
 524     foreach my $name (@names) {
 525         timethis ($n, $alt -> {$name}, $name, $style);
 526     }
 527 }
 528
 529 1;