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