lib/Benchmark.pm

   1 package Benchmark;
   2
   3 # Purpose: benchmark running times of code.
   4 #
   5 #
   6 # Usage - to time code snippets and print results:
   7 #
   8 #       timethis($count, '...code...');
   9 #
  10 # prints:
  11 #       timethis 100:  2 secs ( 0.23 usr  0.10 sys =  0.33 cpu)
  12 #
  13 #
  14 #       timethese($count, {
  15 #               Name1 => '...code1...',
  16 #               Name2 => '...code2...',
  17 #               ... });
  18 # prints:
  19 #       Benchmark: timing 100 iterations of Name1, Name2...
  20 #            Name1:  2 secs ( 0.50 usr  0.00 sys =  0.50 cpu)
  21 #            Name2:  1 secs ( 0.48 usr  0.00 sys =  0.48 cpu)
  22 #
  23 # The default display style will automatically add child process
  24 # values if non-zero.
  25 #
  26 #
  27 # Usage - to time sections of your own code:
  28 #
  29 #       use Benchmark;
  30 #       $t0 = new Benchmark;
  31 #       ... your code here ...
  32 #       $t1 = new Benchmark;
  33 #       $td = &timediff($t1, $t0);
  34 #       print "the code took:",timestr($td),"\n";
  35 #
  36 #       $t = &timeit($count, '...other code...')
  37 #       print "$count loops of other code took:",timestr($t),"\n";
  38 #
  39 #
  40 # Data format:
  41 #       The data is stored as a list of values from the time and times
  42 #       functions: ($real, $user, $system, $children_user, $children_system)
  43 #       in seconds for the whole loop (not divided by the number of rounds).
  44 #
  45 # Internals:
  46 #       The timing is done using time(3) and times(3).
  47 #
  48 #       Code is executed in the callers package
  49 #
  50 #       Enable debugging by:  $Benchmark::debug = 1;
  51 #
  52 #       The time of the null loop (a loop with the same
  53 #       number of rounds but empty loop body) is substracted
  54 #       from the time of the real loop.
  55 #
  56 #       The null loop times are cached, the key being the
  57 #       number of rounds. The caching can be controlled using
  58 #       &clearcache($key); &clearallcache;
  59 #       &disablecache; &enablecache;
  60 #
  61 # Caveats:
  62 #
  63 #       The real time timing is done using time(2) and
  64 #       the granularity is therefore only one second.
  65 #
  66 #       Short tests may produce negative figures because perl
  67 #       can appear to take longer to execute the empty loop
  68 #       than a short test: try timethis(100,'1');
  69 #
  70 #       The system time of the null loop might be slightly
  71 #       more than the system time of the loop with the actual
  72 #       code and therefore the difference might end up being < 0
  73 #
  74 #       More documentation is needed :-(
  75 #       Especially for styles and formats.
  76 #
  77 # Authors:      Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
  78 #               Tim Bunce <Tim.Bunce@ig.co.uk>
  79 #
  80 #
  81 # Last updated: Sept 8th 94 by Tim Bunce
  82 #
  83
  84 use Exporter;
  85 @ISA=(Exporter);
  86 @EXPORT=qw(timeit timethis timethese timediff timestr);
  87 @EXPORT_OK=qw(clearcache clearallcache disablecache enablecache);
  88
  89 &init;
  90
  91 sub init {
  92     $debug = 0;
  93     $min_count = 4;
  94     $min_cpu   = 0.4;
  95     $defaultfmt = '5.2f';
  96     $defaultstyle = 'auto';
  97     # The cache can cause a slight loss of sys time accuracy. If a
  98     # user does many tests (>10) with *very* large counts (>10000)
  99     # or works on a very slow machine the cache may be useful.
 100     &disablecache;
 101     &clearallcache;
 102 }
 103
 104 sub clearcache    { delete $cache{$_[0]}; }
 105 sub clearallcache { %cache = (); }
 106 sub enablecache   { $cache = 1; }
 107 sub disablecache  { $cache = 0; }
 108
 109
 110 # --- Functions to process the 'time' data type
 111
 112 sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; }
 113
 114 sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps         ; }
 115 sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]};         $cu+$cs ; }
 116 sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; }
 117 sub real  { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r              ; }
 118
 119 sub timediff{
 120     my($a, $b) = @_;
 121     my(@r);
 122     for($i=0; $i < @$a; ++$i){
 123         push(@r, $a->[$i] - $b->[$i]);
 124     }
 125     bless \@r;
 126 }
 127
 128 sub timestr{
 129     my($tr, $style, $f) = @_;
 130     my(@t) = @$tr;
 131     warn "bad time value" unless @t==5;
 132     my($r, $pu, $ps, $cu, $cs) = @t;
 133     my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a);
 134     $f = $defaultfmt unless $f;
 135     # format a time in the required style, other formats may be added here
 136     $style = $defaultstyle unless $style;
 137     $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/;
 138     my($s) = "@t $style"; # default for unknown style
 139     $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)",
 140                             @t,$t) if $style =~ /^all$/;
 141     $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)",
 142                             $r,$pu,$ps,$pt) if $style =~ /^noc$/;
 143     $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)",
 144                             $r,$cu,$cs,$ct) if $style =~ /^nop$/;
 145     $s;
 146 }
 147 sub timedebug{
 148     my($msg, $t) = @_;
 149     print STDERR "$msg",timestr($t),"\n" if ($debug);
 150 }
 151
 152
 153 # --- Functions implementing low-level support for timing loops
 154
 155 sub runloop {
 156     my($n, $c) = @_;
 157     my($t0, $t1, $td); # before, after, difference
 158
 159     # find package of caller so we can execute code there
 160     my ($curpack) = caller(0);
 161     my ($i, $pack)= 0;
 162     while (($pack) = caller(++$i)) {
 163         last if $pack ne $curpack;
 164     }
 165
 166     my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }";
 167     my $subref  = eval $subcode;
 168     die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
 169     print STDERR "runloop $n '$subcode'\n" if ($debug);
 170
 171     $t0 = &new;
 172     &$subref;
 173     $t1 = &new;
 174     $td = &timediff($t1, $t0);
 175
 176     timedebug("runloop:",$td);
 177     $td;
 178 }
 179
 180
 181 sub timeit {
 182     my($n, $code) = @_;
 183     my($wn, $wc, $wd);
 184
 185     printf STDERR "timeit $n $code\n" if $debug;
 186
 187     if ($cache && exists $cache{$n}){
 188         $wn = $cache{$n};
 189     }else{
 190         $wn = &runloop($n, '');
 191         $cache{$n} = $wn;
 192     }
 193
 194     $wc = &runloop($n, $code);
 195
 196     $wd = timediff($wc, $wn);
 197
 198     timedebug("timeit: ",$wc);
 199     timedebug("      - ",$wn);
 200     timedebug("      = ",$wd);
 201
 202     $wd;
 203 }
 204
 205
 206 # --- Functions implementing high-level time-then-print utilities
 207
 208 sub timethis{
 209     my($n, $code, $title, $style) = @_;
 210     my($t) = timeit($n, $code);
 211     local($|) = 1;
 212     $title = "timethis $n" unless $title;
 213     $style = "" unless $style;
 214     printf("%10s: ", $title);
 215     print timestr($t, $style),"\n";
 216     # A conservative warning to spot very silly tests.
 217     # Don't assume that your benchmark is ok simply because
 218     # you don't get this warning!
 219     print "            (warning: too few iterations for a reliable count)\n"
 220         if (   $n < $min_count
 221             || ($t->real < 1 && $n < 1000)
 222             || $t->cpu_a < $min_cpu);
 223     $t;
 224 }
 225
 226
 227 sub timethese{
 228     my($n, $alt, $style) = @_;
 229     die "usage: timethese(count, { 'Name1'=>'code1', ... }\n"
 230                 unless ref $alt eq HASH;
 231     my(@all);
 232     my(@names) = sort keys %$alt;
 233     $style = "" unless $style;
 234     print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n";
 235     foreach(@names){
 236         $t = timethis($n, $alt->{$_}, $_, $style);
 237         push(@all, $t);
 238     }
 239     # we could produce a summary from @all here
 240     # sum, min, max, avg etc etc
 241     @all;
 242 }
 243
 244
 245 1;