view release on metacpan or  search on metacpan

benchmarking/BenchAccel.pm  view on Meta::CPAN

		# Calibrate over 50 ms so the real run lands close to $target s
		# regardless of how fast or slow the variant is.
		my $cal_iters = 0;
		my $cal_t0    = time;
		while ( time - $cal_t0 < 0.05 ) { $code->(); $cal_iters++ }
		my $cal_elapsed = ( time - $cal_t0 )                         || 1e-9;
		my $iters       = int( $cal_iters / $cal_elapsed * $target ) || 1;

		# Real timed run.
		my $t0 = time;
		$code->() for 1 .. $iters;
		my $elapsed = ( time - $t0 ) || 1e-9;
		$res{$name} = { iters => $iters, rate => $iters / $elapsed };
	} ## end for my $name ( sort keys %$vars )

	my @names  = sort { $res{$a}{rate} <=> $res{$b}{rate} } keys %res;
	my $name_w = 1;
	for my $n (@names) { $name_w = length $n if length $n > $name_w }
	my $col_w = $name_w < 8 ? 8 : $name_w;

	printf "  %-*s  %10s", $name_w, '', 'Rate';
	printf "  %*s", $col_w, $_ for @names;
	print "\n";

	for my $a (@names) {
		printf "  %-*s  %10s", $name_w, $a, _fmt_rate( $res{$a}{rate} );
		for my $b (@names) {
			if ( $a eq $b ) {
				printf "  %*s", $col_w, '--';
				next;
			}
			my $pct = ( $res{$a}{rate} - $res{$b}{rate} ) / $res{$b}{rate} * 100;
			printf "  %*s", $col_w, sprintf( '%+d%%', int($pct) );
		}
		print "\n";
	} ## end for my $a (@names)
} ## end sub wall_cmpthese

sub _fmt_rate {
	my $r = shift;
	return sprintf '%.2g/s', $r if $r < 1;
	return sprintf '%.2f/s', $r if $r < 100;
	return sprintf '%.0f/s', $r;
}

# wall_rate($code, $secs) -- scalar ops/second over $secs wall-clock
# seconds.  Returns the rate as a plain number so callers can format
# their own tables.
#
# The measurement is split into 3 equal sub-windows and the median of
# their rates is returned.  At small workloads (a few hundred
# microseconds per call) OpenMP thread scheduling is non-deterministic
# enough that a single 2-second window can land in a slow stretch and
# report ~30x lower throughput than steady state; median across
# windows smooths that without spending extra time.
sub wall_rate {
	my ( $code, $secs ) = @_;
	$secs ||= 1;

	# Warm-up: at least 0.3 s (matches the original Perl bench() helper
	# this replaced) so OpenMP thread pools are firmly hot before any
	# measurement window starts.  Scales up for long budgets -- a 30 s
	# measurement gets a 3 s warmup.
	my $warmup = $secs * 0.1;
	$warmup = 0.3 if $warmup < 0.3;
	my $wt0 = time;
	$code->() while time - $wt0 < $warmup;

	my $WINDOWS  = 3;
	my $win_secs = $secs / $WINDOWS;
	my @rates;
	for ( 1 .. $WINDOWS ) {
		my $t0 = time;
		my $n  = 0;
		while ( time - $t0 < $win_secs ) { $code->(); $n++ }
		my $elapsed = ( time - $t0 ) || 1e-9;
		push @rates, $n / $elapsed;
	}
	my @s = sort { $a <=> $b } @rates;
	return $s[ int( @s / 2 ) ];
} ## end sub wall_rate

# wall_time_median($code, $reps) -- single warm-up + $reps timed
# invocations; returns the median elapsed time in seconds.  Use this
# when each call is expensive enough that running it on a $secs budget
# would either be wasteful (3 calls in 2 s tells you little more than
# 3 calls in 30 s) or pull in confounders like GC pauses.
sub wall_time_median {
	my ( $code, $reps ) = @_;
	$reps = 5 unless $reps && $reps >= 1;

	$code->();    # warm-up: covers Inline::C compile, first-touch cache

	my @times;
	for ( 1 .. $reps ) {
		my $t0 = time;
		$code->();
		push @times, time - $t0;
	}
	my @s = sort { $a <=> $b } @times;
	return $s[ int( @s / 2 ) ];
} ## end sub wall_time_median

1;