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     timethese($count, {
  18         'Name1' => '...code1...',
  19         'Name2' => '...code2...',
  20     });
  21
  22     $t = timeit($count, '...other code...')
  23     print "$count loops of other code took:",timestr($t),"\n";
  24
  25 =head1 DESCRIPTION
  26
  27 The Benchmark module encapsulates a number of routines to help you
  28 figure out how long it takes to execute some code.
  29
  30 =head2 Methods
  31
  32 =over 10
  33
  34 =item new
  35
  36 Returns the current time.   Example:
  37
  38     use Benchmark;
  39     $t0 = new Benchmark;
  40     # ... your code here ...
  41     $t1 = new Benchmark;
  42     $td = timediff($t1, $t0);
  43     print "the code took:",timestr($td),"\n";
  44
  45 =item debug
  46
  47 Enables or disable debugging by setting the C<$Benchmark::Debug> flag:
  48
  49     debug Benchmark 1;
  50     $t = timeit(10, ' 5 ** $Global ');
  51     debug Benchmark 0;
  52
  53 =back
  54
  55 =head2 Standard Exports
  56
  57 The following routines will be exported into your namespace
  58 if you use the Benchmark module:
  59
  60 =over 10
  61
  62 =item timeit(COUNT, CODE)
  63
  64 Arguments: COUNT is the number of time to run the loop, and
  65 the second is the code to run.  CODE may be a string containing the code,
  66 a reference to the function to run, or a reference to a hash containing
  67 keys which are names and values which are more CODE specs.
  68
  69 Side-effects: prints out noise to standard out.
  70
  71 Returns: a Benchmark object.
  72
  73 =item timethis
  74
  75 =item timethese
  76
  77 =item timediff
  78
  79 =item timestr
  80
  81 =back
  82
  83 =head2 Optional Exports
  84
  85 The following routines will be exported into your namespace
  86 if you specifically ask that they be imported:
  87
  88 =over 10
  89
  90 clearcache
  91
  92 clearallcache
  93
  94 disablecache
  95
  96 enablecache
  97
  98 =back
  99
 100 =head1 NOTES
 101
 102 The data is stored as a list of values from the time and times
 103 functions:
 104
 105       ($real, $user, $system, $children_user, $children_system)
 106
 107 in seconds for the whole loop (not divided by the number of rounds).
 108
 109 The timing is done using time(3) and times(3).
 110
 111 Code is executed in the caller's package.
 112
 113 Enable debugging by:
 114
 115     $Benchmark::debug = 1;
 116
 117 The time of the null loop (a loop with the same
 118 number of rounds but empty loop body) is subtracted
 119 from the time of the real loop.
 120
 121 The null loop times are cached, the key being the
 122 number of rounds. The caching can be controlled using
 123 calls like these:
 124
 125     clearcache($key);
 126     clearallcache();
 127
 128     disablecache();
 129     enablecache();
 130
 131 =head1 INHERITANCE
 132
 133 Benchmark inherits from no other class, except of course
 134 for Exporter.
 135
 136 =head1 CAVEATS
 137
 138 The real time timing is done using time(2) and
 139 the granularity is therefore only one second.
 140
 141 Short tests may produce negative figures because perl
 142 can appear to take longer to execute the empty loop
 143 than a short test; try:
 144
 145     timethis(100,'1');
 146
 147 The system time of the null loop might be slightly
 148 more than the system time of the loop with the actual
 149 code and therefore the difference might end up being E<lt> 0.
 150
 151 More documentation is needed :-( especially for styles and formats.
 152
 153 =head1 AUTHORS
 154
 155 Jarkko Hietaniemi E<lt>F<Jarkko.Hietaniemi@hut.fi>E<gt>,
 156 Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>
 157
 158 =head1 MODIFICATION HISTORY
 159
 160 September 8th, 1994; by Tim Bunce.
 161
 162 =cut
 163
 164 # Purpose: benchmark running times of code.
 165 #
 166 #
 167 # Usage - to time code snippets and print results:
 168 #
 169 #       timethis($count, '...code...');
 170 #
 171 # prints:
 172 #       timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
 173 #
 174 #
 175 #       timethese($count, {
 176 #               Name1 => '...code1...',
 177 #               Name2 => '...code2...',
 178 #               ... });
 179 # prints:
 180 #       Benchmark: timing 100 iterations of Name1, Name2...
 181 #            Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
 182 #            Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
 183 #
 184 # The default display style will automatically add child process
 185 # values if non-zero.
 186 #
 187 #
 188 # Usage - to time sections of your own code:
 189 #
 190 #       use Benchmark;
 191 #       $t0 = new Benchmark;
 192 #       ... your code here ...
 193 #       $t1 = new Benchmark;
 194 #       $td = &timediff($t1, $t0);
 195 #       print "the code took:",timestr($td),"\n";
 196 #
 197 #       $t = &timeit($count, '...other code...')
 198 #       print "$count loops of other code took:",timestr($t),"\n";
 199 #
 200 #
 201 # Data format:
 202 #       The data is stored as a list of values from the time and times
 203 #       functions: ($real, $user, $system, $children_user, $children_system)
 204 #       in seconds for the whole loop (not divided by the number of rounds).
 205 #
 206 # Internals:
 207 #       The timing is done using time(3) and times(3).
 208 #
 209 #       Code is executed in the callers package
 210 #
 211 #       Enable debugging by:  $Benchmark::debug = 1;
 212 #
 213 #       The time of the null loop (a loop with the same
 214 #       number of rounds but empty loop body) is substracted
 215 #       from the time of the real loop.
 216 #
 217 #       The null loop times are cached, the key being the
 218 #       number of rounds. The caching can be controlled using
 219 #       &clearcache($key); &clearallcache;
 220 #       &disablecache; &enablecache;
 221 #
 222 # Caveats:
 223 #
 224 #       The real time timing is done using time(2) and
 225 #       the granularity is therefore only one second.
 226 #
 227 #       Short tests may produce negative figures because perl
 228 #       can appear to take longer to execute the empty loop
 229 #       than a short test: try timethis(100,'1');
 230 #
 231 #       The system time of the null loop might be slightly
 232 #       more than the system time of the loop with the actual
 233 #       code and therefore the difference might end up being < 0
 234 #
 235 #       More documentation is needed :-(
 236 #       Especially for styles and formats.
 237 #
 238 # Authors:      Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
 239 #               Tim Bunce <Tim.Bunce@ig.co.uk>
 240 #
 241 #
 242 # Last updated: Sept 8th 94 by Tim Bunce
 243 #
 244
 245 use Carp;
 246 use Exporter;
 247 @ISA=(Exporter);
 248 @EXPORT=qw(timeit timethis timethese timediff timestr);
 249 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
 250
 251 &init;
 252
 253 sub init {
 254     $debug = 0;
 255     $min_count = 4;
 256     $min_cpu   = 0.4;
 257     $defaultfmt = '5.2f';
 258     $defaultstyle = 'auto';
 259     # The cache can cause a slight loss of sys time accuracy. If a
 260     # user does many tests (>10) with *very* large counts (>10000)
 261     # or works on a very slow machine the cache may be useful.
 262     &disablecache;
 263     &clearallcache;
 264 }
 265
 266 sub clearcache    { delete $cache{$_[0]}; }
 267 sub clearallcache { %cache = (); }
 268 sub enablecache   { $cache = 1; }
 269 sub disablecache  { $cache = 0; }
 270
 271
 272 # --- Functions to process the 'time' data type
 273
 274 sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
 275
 276 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 277 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 278 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 279 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 280
 281 sub timediff{
 282     my($a, $b) = @_;
 283     my(@r);
 284     for($i=0; $i < @$a; ++$i){
 285         push(@r, $a->[$i] - $b->[$i]);
 286     }
 287     bless \@r;
 288 }
 289
 290 sub timestr{
 291     my($tr, $style, $f) = @_;
 292     my(@t) = @$tr;
 293     warn "bad time value" unless @t==5;
 294     my($r, $pu, $ps, $cu, $cs) = @t;
 295     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 296     $f = $defaultfmt unless $f;
 297     # format a time in the required style, other formats may be added here
 298     $style = $defaultstyle unless $style;
 299     $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
 300     my($s) = "@t $style"; # default for unknown style
 301     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
 302                             @t,$t) if $style =~ /^all$/;
 303     $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
 304                             $r,$pu,$ps,$pt) if $style =~ /^noc$/;
 305     $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
 306                             $r,$cu,$cs,$ct) if $style =~ /^nop$/;
 307     $s;
 308 }
 309 sub timedebug{
 310     my($msg, $t) = @_;
 311     print STDERR "$msg",timestr($t),"\n" if ($debug);
 312 }
 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 "negativ loopcount $n" if $n<0;
 322     confess "Usage: runloop(number, string)" 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 = &new;
 340     &$subref;
 341     $t1 = &new;
 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 # --- Functions implementing high-level time-then-print utilities
 375
 376 sub timethis{
 377     my($n, $code, $title, $style) = @_;
 378     my($t) = timeit($n, $code);
 379     local($|) = 1;
 380     $title = "timethis $n" unless $title;
 381     $style = "" unless $style;
 382     printf("%10s: ", $title);
 383     print timestr($t, $style),"\n";
 384     # A conservative warning to spot very silly tests.
 385     # Don't assume that your benchmark is ok simply because
 386     # you don't get this warning!
 387     print "            (warning: too few iterations for a reliable count)\n"
 388         if (   $n < $min_count
 389             || ($t->real < 1 && $n < 1000)
 390             || $t->cpu_a < $min_cpu);
 391     $t;
 392 }
 393
 394
 395 sub timethese{
 396     my($n, $alt, $style) = @_;
 397     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 398                 unless ref $alt eq HASH;
 399     my(@all);
 400     my(@names) = sort keys %$alt;
 401     $style = "" unless $style;
 402     print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
 403     foreach(@names){
 404         $t = timethis($n, $alt->{$_}, $_, $style);
 405         push(@all, $t);
 406     }
 407     # we could produce a summary from @all here
 408     # sum, min, max, avg etc etc
 409     @all;
 410 }
 411
 412
 413 1;