view release on metacpan or  search on metacpan

benchmarking/BenchAccel.pm  view on Meta::CPAN

package BenchAccel;

# Shared wall-clock timing helpers for the benchmarking/ scripts.
#
# Benchmark::cmpthese is unsafe for comparing OpenMP-parallel code
# against serial code: its rate column is computed from CPU time
# (user + sys), and an OpenMP `parallel for` running on N cores
# consumes ~N x the CPU time of its serial counterpart even when
# wall-clock time drops.  That makes the c_openmp variant look
# *slower* than c_serial in cmpthese output -- the opposite of what
# a user actually experiences.
#
# This module replaces it with three Time::HiRes-based helpers, used
# across every bench script in this directory so they share a single
# timing path:
#
#   wall_cmpthese($target_secs, \%vars)
#       cmpthese-style comparison table, sorted slowest -> fastest with
#       a pairwise percent-difference matrix.  Prints only; returns
#       nothing.  Used when comparing several alternatives at once.
#
#   wall_rate($code, $secs)
#       Warm up briefly, then time $code for $secs wall-clock seconds.
#       Returns ops/second as a scalar.  Used when the script formats
#       its own table (e.g. bench-sklearn-scoring's side-by-side
#       Perl-vs-sklearn rows).
#
#   wall_time_median($code, $reps)
#       Run $code once as a warm-up, then time exactly $reps invocations
#       and return the median elapsed time in seconds.  Used when each
#       invocation is too expensive to run on a time budget (fit() at
#       large sizes); the small fixed sample with median statistic
#       resists outliers without burning a 2-second budget per row.

use strict;
use warnings;
use Time::HiRes qw(time);
use Exporter    qw(import);

our @EXPORT_OK = qw(wall_cmpthese wall_rate wall_time_median);

sub wall_cmpthese {
	my ( $target_secs, $vars ) = @_;
	my $target = abs( $target_secs || 0 ) || 1;

	my %res;
	for my $name ( sort keys %$vars ) {
		my $code = $vars->{$name};

		# Warm-up: one call absorbs first-touch and cache-miss spikes
		# so the calibration window measures steady-state cost.
		$code->();

		# 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} );