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 Count can be zero or negative, see timethis().
 119
 120 =item timediff ( T1, T2 )
 121
 122 Returns the difference between two Benchmark times as a Benchmark
 123 object suitable for passing to timestr().
 124
 125 =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
 126
 127 Returns a string that formats the times in the TIMEDIFF object in
 128 the requested STYLE. TIMEDIFF is expected to be a Benchmark object
 129 similar to that returned by timediff().
 130
 131 STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each
 132 of the 5 times available ('wallclock' time, user time, system time,
 133 user time of children, and system time of children). 'noc' shows all
 134 except the two children times. 'nop' shows only wallclock and the
 135 two children times. 'auto' (the default) will act as 'all' unless
 136 the children times are both zero, in which case it acts as 'noc'.
 137
 138 FORMAT is the L<printf(3)>-style format specifier (without the
 139 leading '%') to use to print the times. It defaults to '5.2f'.
 140
 141 =back
 142
 143 =head2 Optional Exports
 144
 145 The following routines will be exported into your namespace
 146 if you specifically ask that they be imported:
 147
 148 =over 10
 149
 150 =item clearcache ( COUNT )
 151
 152 Clear the cached time for COUNT rounds of the null loop.
 153
 154 =item clearallcache ( )
 155
 156 Clear all cached times.
 157
 158 =item disablecache ( )
 159
 160 Disable caching of timings for the null loop. This will force Benchmark
 161 to recalculate these timings for each new piece of code timed.
 162
 163 =item enablecache ( )
 164
 165 Enable caching of timings for the null loop. The time taken for COUNT
 166 rounds of the null loop will be calculated only once for each
 167 different COUNT used.
 168
 169 =back
 170
 171 =head1 NOTES
 172
 173 The data is stored as a list of values from the time and times
 174 functions:
 175
 176       ($real, $user, $system, $children_user, $children_system)
 177
 178 in seconds for the whole loop (not divided by the number of rounds).
 179
 180 The timing is done using time(3) and times(3).
 181
 182 Code is executed in the caller's package.
 183
 184 The time of the null loop (a loop with the same
 185 number of rounds but empty loop body) is subtracted
 186 from the time of the real loop.
 187
 188 The null loop times are cached, the key being the
 189 number of rounds. The caching can be controlled using
 190 calls like these:
 191
 192     clearcache($key);
 193     clearallcache();
 194
 195     disablecache();
 196     enablecache();
 197
 198 =head1 INHERITANCE
 199
 200 Benchmark inherits from no other class, except of course
 201 for Exporter.
 202
 203 =head1 CAVEATS
 204
 205 Comparing eval'd strings with code references will give you
 206 inaccurate results: a code reference will show a slower
 207 execution time than the equivalent eval'd string.
 208
 209 The real time timing is done using time(2) and
 210 the granularity is therefore only one second.
 211
 212 Short tests may produce negative figures because perl
 213 can appear to take longer to execute the empty loop
 214 than a short test; try:
 215
 216     timethis(100,'1');
 217
 218 The system time of the null loop might be slightly
 219 more than the system time of the loop with the actual
 220 code and therefore the difference might end up being E<lt> 0.
 221
 222 =head1 AUTHORS
 223
 224 Jarkko Hietaniemi <F<jhi@iki.fi>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>
 225
 226 =head1 MODIFICATION HISTORY
 227
 228 September 8th, 1994; by Tim Bunce.
 229
 230 March 28th, 1997; by Hugo van der Sanden: added support for code
 231 references and the already documented 'debug' method; revamped
 232 documentation.
 233
 234 April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time
 235 functionality.
 236
 237 =cut
 238
 239 use Carp;
 240 use Exporter;
 241 @ISA=(Exporter);
 242 @EXPORT=qw(timeit timethis timethese timediff timestr);
 243 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
 244
 245 &init;
 246
 247 sub init {
 248     $debug = 0;
 249     $min_count = 4;
 250     $min_cpu   = 0.4;
 251     $defaultfmt = '5.2f';
 252     $defaultstyle = 'auto';
 253     # The cache can cause a slight loss of sys time accuracy. If a
 254     # user does many tests (>10) with *very* large counts (>10000)
 255     # or works on a very slow machine the cache may be useful.
 256     &disablecache;
 257     &clearallcache;
 258 }
 259
 260 sub debug { $debug = ($_[1] != 0); }
 261
 262 sub clearcache    { delete $cache{$_[0]}; }
 263 sub clearallcache { %cache = (); }
 264 sub enablecache   { $cache = 1; }
 265 sub disablecache  { $cache = 0; }
 266
 267 # --- Functions to process the 'time' data type
 268
 269 sub new { my @t = (time, times, @_ == 2 ? $_[1] : 0);
 270           print "new=@t\n" if $debug;
 271           bless \@t; }
 272
 273 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 274 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 275 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 276 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 277
 278 sub timediff {
 279     my($a, $b) = @_;
 280     my @r;
 281     for ($i=0; $i < @$a; ++$i) {
 282         push(@r, $a->[$i] - $b->[$i]);
 283     }
 284     bless \@r;
 285 }
 286
 287 sub timestr {
 288     my($tr, $style, $f) = @_;
 289     my @t = @$tr;
 290     warn "bad time value (@t)" unless @t==6;
 291     my($r, $pu, $ps, $cu, $cs, $n) = @t;
 292     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 293     $f = $defaultfmt unless defined $f;
 294     # format a time in the required style, other formats may be added here
 295     $style ||= $defaultstyle;
 296     $style = ($ct>0) ? 'all' : 'noc' if $style eq 'auto';
 297     my $s = "@t $style"; # default for unknown style
 298     $s=sprintf("%2d wallclock secs (%$f usr %$f sys + %$f cusr %$f csys = %$f CPU secs)",
 299                             @t,$t) if $style eq 'all';
 300     $s=sprintf("%$f CPU secs (%$f usr + %$f sys)",
 301                             $pt,$pu,$ps) if $style eq 'noc';
 302     $s=sprintf("%$f CPU secs (%$f cusr %$f csys)",
 303                             $ct,$cu,$cs) if $style eq 'nop';
 304     $s .= sprintf(" @ %$f/s (n=$n)", $n / ( $pu + $ps )) if $n;
 305     $s;
 306 }
 307
 308 sub timedebug {
 309     my($msg, $t) = @_;
 310     print STDERR "$msg",timestr($t),"\n" if $debug;
 311 }
 312
 313 # --- Functions implementing low-level support for timing loops
 314
 315 sub runloop {
 316     my($n, $c) = @_;
 317
 318     $n+=0; # force numeric now, so garbage won't creep into the eval
 319     croak "negative loopcount $n" if $n<0;
 320     confess "Usage: runloop(number, [string | coderef])" unless defined $c;
 321     my($t0, $t1, $td); # before, after, difference
 322
 323     # find package of caller so we can execute code there
 324     my($curpack) = caller(0);
 325     my($i, $pack)= 0;
 326     while (($pack) = caller(++$i)) {
 327         last if $pack ne $curpack;
 328     }
 329
 330     my $subcode = (ref $c eq 'CODE')
 331         ? "sub { package $pack; my(\$_i)=$n; while (\$_i--){&\$c;} }"
 332         : "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
 333     my $subref  = eval $subcode;
 334     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 335     print STDERR "runloop $n '$subcode'\n" if $debug;
 336
 337     $t0 = Benchmark->new(0);
 338     &$subref;
 339     $t1 = Benchmark->new($n);
 340     $td = &timediff($t1, $t0);
 341
 342     timedebug("runloop:",$td);
 343     $td;
 344 }
 345
 346
 347 sub timeit {
 348     my($n, $code) = @_;
 349     my($wn, $wc, $wd);
 350
 351     printf STDERR "timeit $n $code\n" if $debug;
 352
 353     if ($cache && exists $cache{$n}) {
 354         $wn = $cache{$n};
 355     } else {
 356         $wn = &runloop($n, '');
 357         $cache{$n} = $wn;
 358     }
 359
 360     $wc = &runloop($n, $code);
 361
 362     $wd = timediff($wc, $wn);
 363
 364     timedebug("timeit: ",$wc);
 365     timedebug("      - ",$wn);
 366     timedebug("      = ",$wd);
 367
 368     $wd;
 369 }
 370
 371
 372 my $default_for = 3;
 373 my $min_for     = 0.1;
 374
 375 sub runfor {
 376     my ($code, $tmax) = @_;
 377
 378     if ( not defined $tmax or $tmax == 0 ) {
 379         $tmax = $default_for;
 380     } elsif ( $tmax < 0 ) {
 381         $tmax = -$tmax;
 382     }
 383
 384     die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n"
 385         if $tmax < $min_for;
 386
 387     my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );
 388
 389     # First find the minimum $n that gives a non-zero timing.
 390
 391     my $nmin;
 392
 393     for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
 394         $td = timeit($n, $code);
 395         $tc = $td->[1] + $td->[2];
 396     }
 397
 398     $nmin = $n;
 399
 400     my $ttot = 0;
 401     my $tpra = 0.05 * $tmax; # Target/time practice.
 402
 403     # Double $n until we have think we have practiced enough.
 404     for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
 405         $td = timeit($n, $code);
 406         $tc = $td->cpu_p;
 407         $ntot += $n;
 408         $rtot += $td->[0];
 409         $utot += $td->[1];
 410         $stot += $td->[2];
 411         $ttot = $utot + $stot;
 412         $cutot += $td->[3];
 413         $cstot += $td->[4];
 414     }
 415
 416     my $r;
 417
 418     # Then iterate towards the $tmax.
 419     while ( $ttot < $tmax ) {
 420         $r = $tmax / $ttot - 1; # Linear approximation.
 421         $n = int( $r * $n );
 422         $n = $nmin if $n < $nmin;
 423         $td = timeit($n, $code);
 424         $ntot += $n;
 425         $rtot += $td->[0];
 426         $utot += $td->[1];
 427         $stot += $td->[2];
 428         $ttot = $utot + $stot;
 429         $cutot += $td->[3];
 430         $cstot += $td->[4];
 431     }
 432
 433     return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ];
 434 }
 435
 436 # --- Functions implementing high-level time-then-print utilities
 437
 438 sub n_to_for {
 439     my $n = shift;
 440     return $n == 0 ? $default_for : $n < 0 ? -$n : undef;
 441 }
 442
 443 sub timethis{
 444     my($n, $code, $title, $style) = @_;
 445     my($t, $for, $forn);
 446
 447     if ( $n > 0 ) {
 448         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 449         $t = timeit($n, $code);
 450         $title = "timethis $n" unless defined $title;
 451     } else {
 452         $fort  = n_to_for( $n );
 453         $t     = runfor($code, $fort);
 454         $title = "timethis for $fort" unless defined $title;
 455         $forn  = $t->[-1];
 456     }
 457     local $| = 1;
 458     $style = "" unless defined $style;
 459     printf("%10s: ", $title);
 460     print timestr($t, $style, $defaultfmt),"\n";
 461
 462     $n = $forn if defined $forn;
 463
 464     # A conservative warning to spot very silly tests.
 465     # Don't assume that your benchmark is ok simply because
 466     # you don't get this warning!
 467     print "            (warning: too few iterations for a reliable count)\n"
 468         if     $n < $min_count
 469             || ($t->real < 1 && $n < 1000)
 470             || $t->cpu_a < $min_cpu;
 471     $t;
 472 }
 473
 474 sub timethese{
 475     my($n, $alt, $style) = @_;
 476     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 477                 unless ref $alt eq HASH;
 478     my @names = sort keys %$alt;
 479     $style = "" unless defined $style;
 480     print "Benchmark: ";
 481     if ( $n > 0 ) {
 482         croak "non-integer loopcount $n, stopped" if int($n)<$n;
 483         print "timing $n iterations of";
 484     } else {
 485         print "running";
 486     }
 487     print " ", join(', ',@names);
 488     unless ( $n > 0 ) {
 489         my $for = n_to_for( $n );
 490         print ", each for at least $for CPU seconds";
 491     }
 492     print "...\n";
 493
 494     # we could save the results in an array and produce a summary here
 495     # sum, min, max, avg etc etc
 496     foreach my $name (@names) {
 497         timethis ($n, $alt -> {$name}, $name, $style);
 498     }
 499 }
 500
 501 1;