[PATCH 5.005_61] Better tweak to Benchmark.pm [Was: mixed benchmarks]

[p5pRT]

Migrated from rt.perl.org#1476 (status was 'resolved')

Searchable as RT1476$

[p5pRT]

From The RT System itself

And now I think I do know​:

  sub {}

runs slower than

  sub { undef }

as it turns out.

This patch supercedes the one of too few hours ago, and gives more
consistent results faster (

[barries@​jester Benchmark]$ time perl ft -1
perl v5.00503, min of 1 seconds per test
  sub1​: 0 wallclock secs ( 1.06 usr + 0.00 sys = 1.06 CPU) @​ 2308185.85/s (n=2446677)
  sub2​: 0 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @​ 1170284.82/s (n=1310719)
  str1​: 3 wallclock secs ( 1.12 usr + 0.00 sys = 1.12 CPU) @​ 2340571.43/s (n=2621440)
  str2​: 2 wallclock secs ( 1.07 usr + 0.00 sys = 1.07 CPU) @​ 1143306.54/s (n=1223338)
  Rate sub1 sub2 str1 str2
  sub1 2308185/s 0.00
  sub2 1170284/s -49.30 0.00
  str1 2340571/s 1.40 100.00 0.00
  str2 1143306/s -50.47 -2.31 -51.15 0.00
41.69user 0.05system 0​:43.31elapsed 96%CPU (0avgtext+0avgdata 0maxresident)k
0inputs+0outputs (262major+82minor)pagefaults 0swaps

) when run on the same test suite (

my @​tests = (
  ['sub1', sub{ $a = 10 } ],
  ['sub2', sub{ $a = 10 ; $a = 10 } ],
  ['str1', '$a = 10' ],
  ['str2', '$a = 10 ; $a = 10' ],
);

for ( @​tests ) {
  push( @​$_, @​{timethis( $count, $_->[1], $_->[0] )} ) ;
}

).

To repeat and embellish the functions of this patch​:

* compares times from sub{...} tests to sub{ undef } instead
  of to '',

* fixes a bug in the linear interpolation responsible for
  pathological looping (usually with very fast code),

* improves the accuracy of the time 0 sample, and

* reduces the number of separate timings that are added together
  for the final result when running a time limited test,
  reducing the additive errors that might accumulate. This is
  done by setting the 'minimum' acceptable time to 0.1 second
  instead of to >= 0, and by the above fix to the linear
  interpolation math.

* fixes a small bug in finding $nmin​: it used to set $nmin to
  twice the found minimum

- Barrie

Inline Patch

--- /var/perls/perl5.005_61/lib/Benchmark.pm	Tue Jul 20 13:17:59 1999
+++ lib/Benchmark.pm	Fri Sep 17 06:47:03 1999
@@ -273,7 +273,9 @@

 sub debug { $debug = ($_[1] != 0); }

-sub clearcache    { delete $cache{$_[0]}; }
+# The cache needs two branches: 's' for strings and 'c' for code.  The
+# emtpy loop is different in these two cases.
+sub clearcache    { delete $cache{"$_[0]c"}; delete $cache{"$_[0]s"}; }
 sub clearallcache { %cache = (); }
 sub enablecache   { $cache = 1; }
 sub disablecache  { $cache = 0; }
@@ -362,11 +364,18 @@
     croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@;
     print STDERR "runloop $n '$subcode'\n" if $debug;

-    $t0 = Benchmark->new(0);
+    # Wait for the user timer to tick.  This makes the error range more like -0.01, +0.  If
+    # we don't wait, then it's more like -0.01, +0.01.  This may not seem important, but it
+    # significantly reduces the chances of getting too low initial $n in the initial, 'find
+    # the minimum' loop in &runfor.  This, in turn, can reduce the number of calls to
+    # &runloop a lot, and thus reduce additive errors.
+    my $tbase = Benchmark->new(0)->[1];
+    do {
+       $t0 = Benchmark->new(0);
+    } while ( $t0->[1] == $tbase ) ;
     &$subref;
     $t1 = Benchmark->new($n);
     $td = &timediff($t1, $t0);

     timedebug("runloop:",$td);
     $td;
 }
@@ -377,12 +386,12 @@
     my($wn, $wc, $wd);

     printf STDERR "timeit $n $code\n" if $debug;

-    if ($cache && exists $cache{$n}) {
-	$wn = $cache{$n};
+    my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ) ;
+    if ($cache && exists $cache{$cache_key} ) {
+	$wn = $cache{$cache_key};
     } else {
-	$wn = &runloop($n, '');
-	$cache{$n} = $wn;
+	$wn = &runloop($n, ref( $code ) ? sub { undef } : '' );
+	$cache{$cache_key} = $wn;
     }

     $wc = &runloop($n, $code);
@@ -414,24 +423,23 @@

     my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot );

-    # First find the minimum $n that gives a non-zero timing.
+    # First find the minimum $n that gives a significant timing.
     
     my $nmin;

-    for ($n = 1, $tc = 0; $tc <= 0; $n *= 2 ) {
+    for ($n = 1, $tc = 0; ; $n *= 2 ) {
 	$td = timeit($n, $code);
 	$tc = $td->[1] + $td->[2];
+	last if $tc > 0.1 ;
     }

     $nmin = $n;

     my $ttot = 0;
     my $tpra = 0.05 * $tmax; # Target/time practice.

     # Double $n until we have think we have practiced enough.
-    for ( $n = 1; $ttot < $tpra; $n *= 2 ) {
+    for ( ; $ttot < $tpra; $n *= 2 ) {
 	$td = timeit($n, $code);
-	$tc = $td->cpu_p;
 	$ntot += $n;
 	$rtot += $td->[0];
 	$utot += $td->[1];
@@ -446,7 +454,7 @@
     # Then iterate towards the $tmax.
     while ( $ttot < $tmax ) {
 	$r = $tmax / $ttot - 1; # Linear approximation.
-	$n = int( $r * $n );
+	$n = int( $r * $ntot );
 	$n = $nmin if $n < $nmin;
 	$td = timeit($n, $code);
 	$ntot += $n;

[p5pRT]

@iabyn - Status changed from 'stalled' to 'resolved'