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