view release on metacpan or  search on metacpan

lib/Benchmark/Lab.pm  view on Meta::CPAN

#pod =for :list
#pod * C<min_secs> – minimum elapsed time in seconds; default 0
#pod * C<max_secs> – maximum elapsed time in seconds; default 300
#pod * C<min_reps> - minimum number of task repetitions; default 1; minimum 1
#pod * C<max_reps> - maximum number of task repetitions; default 100
#pod * C<verbose> – when true, progress will be logged to STDERR; default false
#pod
#pod The logic for benchmark duration is as follows:
#pod
#pod =for :list
#pod * benchmarking always runs until both C<min_secs> and C<min_reps> are
#pod   satisfied
#pod * when profiling, benchmarking stops after minimums are satisfied
#pod * when not profiling, benchmarking stops once one of C<max_secs> or
#pod   C<max_reps> is exceeded.
#pod
#pod Note that "elapsed time" for the C<min_secs> and C<max_secs> is wall-clock
#pod time, not the cumulative recorded time of the task itself.
#pod
#pod =cut

sub new {
    my $class = shift;

    my %defaults = (
        min_secs => 0,
        max_secs => 300,
        min_reps => 1,
        max_reps => 100,
    );

    my $self = bless { %defaults, __pairs(@_) }, $class;

    $self->{min_reps} = 1 if $self->{min_reps} < 1;

    __initialize_nytprof_file( $self->{nytprof_file} )
      if $PROFILING;

    return $self;
}

#pod =method start
#pod
#pod     my $result = $bm->start( $package, $context, $label );
#pod
#pod This method executes the structured benchmark from the given C<$package>.
#pod The C<$context> parameter is passed to all task phases.  The C<$label>
#pod is used for diagnostic output to describe the benchmark being run.
#pod
#pod If parameters are omitted, C<$package> defaults to "main", an empty
#pod hash reference is used for the C<$context>, and the C<$label> defaults
#pod to the C<$package>.
#pod
#pod It returns a hash reference with the following keys:
#pod
#pod =for :list
#pod * C<elapsed> – total wall clock time to execute the benchmark (including
#pod   non-timed portions).
#pod * C<total_time> – sum of recorded task iterations times.
#pod * C<iterations> – total number of C<do_task> functions called.
#pod * C<percentiles> – hash reference with 1, 5, 10, 25, 50, 75, 90, 95 and
#pod   99th percentile iteration times.  There may be duplicates if there were
#pod   fewer than 100 iterations.
#pod * C<median_rate> – the inverse of the 50th percentile time.
#pod * C<timing> – array reference with individual iteration times as (floating
#pod   point) seconds.
#pod
#pod =cut

sub start {
    my ( $self, $package, $context, $label ) = @_;
    $package ||= 'main';
    $context ||= {};
    $label   ||= $package;

    # build dispatch table for package
    my $dispatch = { map { $_ => ( $package->can($_) ) }
          qw( describe setup before_task do_task after_task teardown ) };

    $self->_log("Benchmarking $label");

    $dispatch->{setup}->($context) if $dispatch->{setup};
    my $result = $self->_do_loop( $dispatch, $context );
    $dispatch->{teardown}->($context) if $dispatch->{teardown};

    return $result;
}

#--------------------------------------------------------------------------#
# Private methods
#--------------------------------------------------------------------------#

sub _do_loop {
    my ( $self, $dispatch, $context ) = @_;

    my ( $wall_start, $wall_time ) = ( $CLOCK_FCN->(), 0 );
    my ( $fcn, $n ) = ( $dispatch->{do_task}, 0 );
    $fcn ||= sub () { }; # use NOP if not provided

    my ( $start_time, $end_time, $elapsed, @timing );
    while (( $wall_time < $self->{min_secs} || $n < $self->{min_reps} )
        || ( $wall_time < $self->{max_secs} && $n < $self->{max_reps} && !$PROFILING ) )
    {
        $n++;
        $self->_log("starting loop $n; elapsed time $wall_time");

        $dispatch->{before_task}->($context) if $dispatch->{before_task};

        DB::enable_profile() if $PROFILING;

        $start_time = $CLOCK_FCN->();
        $fcn->($context);
        $end_time = $CLOCK_FCN->();

        DB::disable_profile() if $PROFILING;

        $dispatch->{after_task}->($context) if $dispatch->{after_task};

        $elapsed = $end_time - $start_time;
        if ( $elapsed == 0 ) {
            __croak("Clock granularity too low for this task");
        }

        push @timing, $elapsed;

        $wall_time = $end_time - $wall_start;
    }

    DB::finish_profile() if $PROFILING;

    my $pctiles = $self->_percentiles( \@timing );

    return {
        elapsed     => $wall_time,
        total_time  => List::Util::sum( 0, @timing ),
        iterations  => scalar(@timing),
        percentiles => $pctiles,
        median_rate => 1 / $pctiles->{50},
        timing      => \@timing,
    };
}

sub _log {
    my $self = shift;
    return unless $self->{verbose};
    my @lines = map { chomp; "$_\n" } @_;
    print STDERR @lines;
    return;
}

sub _percentiles {
    my ( $self, $timing ) = @_;

    my $runs = scalar @$timing;
    my @sorted = sort { $a <=> $b } @$timing;

    my %pctiles = map { $_ => $sorted[ int( $_ / 100 * $runs ) ] } 1, 5, 10, 25, 50, 75,
      90, 95, 99;

    return \%pctiles;
}

#--------------------------------------------------------------------------#
# Private functions
#--------------------------------------------------------------------------#

sub __croak {
    require Carp;
    Carp::croak(@_);
}

sub __get_fallback_time {
    return Time::HiRes::time();
}

sub __get_monotonic_time {
    return Time::HiRes::clock_gettime( Time::HiRes::CLOCK_MONOTONIC() );
}

sub __initialize_nytprof_file {
    return if $ENV{NYTPROF} && $ENV{NYTPROF} =~ m/file=/;
    my $file = shift || "nytprof.out";
    DB::enable_profile($file);
    DB::disable_profile();
    return;
}

sub __pairs {
    if ( @_ % 2 != 0 ) {
        __croak("arguments must be key-value pairs");
    }
    return @_;
}

1;


# vim: ts=4 sts=4 sw=4 et tw=75:

__END__

=pod

=encoding UTF-8

=head1 NAME

Benchmark::Lab - Tools for structured benchmarking and profiling

=head1 VERSION

lib/Benchmark/Lab.pm  view on Meta::CPAN

C<max_reps> - maximum number of task repetitions; default 100

=item *

C<verbose> – when true, progress will be logged to STDERR; default false

=back

The logic for benchmark duration is as follows:

=over 4

=item *

benchmarking always runs until both C<min_secs> and C<min_reps> are satisfied

=item *

when profiling, benchmarking stops after minimums are satisfied

=item *

when not profiling, benchmarking stops once one of C<max_secs> or C<max_reps> is exceeded.

=back

Note that "elapsed time" for the C<min_secs> and C<max_secs> is wall-clock
time, not the cumulative recorded time of the task itself.

=head2 start

    my $result = $bm->start( $package, $context, $label );

This method executes the structured benchmark from the given C<$package>.
The C<$context> parameter is passed to all task phases.  The C<$label>
is used for diagnostic output to describe the benchmark being run.

If parameters are omitted, C<$package> defaults to "main", an empty
hash reference is used for the C<$context>, and the C<$label> defaults
to the C<$package>.

It returns a hash reference with the following keys:

=over 4

=item *

C<elapsed> – total wall clock time to execute the benchmark (including non-timed portions).

=item *

C<total_time> – sum of recorded task iterations times.

=item *

C<iterations> – total number of C<do_task> functions called.

=item *

C<percentiles> – hash reference with 1, 5, 10, 25, 50, 75, 90, 95 and 99th percentile iteration times.  There may be duplicates if there were fewer than 100 iterations.

=item *

C<median_rate> – the inverse of the 50th percentile time.

=item *

C<timing> – array reference with individual iteration times as (floating point) seconds.

=back

=for Pod::Coverage BUILD

=head1 CAVEATS

If the C<do_task> executes in less time than the timer granularity, an
error will be thrown.  For benchmarks that do not have before/after functions,
just repeating the function under test in C<do_task> will be sufficient.

=head1 RATIONALE

I believe most approaches to benchmarking are flawed, primarily because
they focus on finding a I<single> measurement.  Single metrics are easy to
grok and easy to compare ("foo was 13% faster than bar!"), but they obscure
the full distribution of timing data and (as a result) are often unstable.

Most of the time, people hand-wave this issue and claim that the Central
Limit Theorem (CLT) solves the problem for a large enough sample size.
Unfortunately, the CLT holds only if means and variances are finite and
some real world distributions are not (e.g. hard drive error frequencies
best fit a Pareto distribution).

Further, we often care more about the shape of the distribution than just a
single point.  For example, I would rather have a process with mean µ that
stays within 0.9µ - 1.1µ  than one that varies from 0.5µ - 1.5µ.

And a process that is 0.1µ 90% of the time and 9.1µ 10% of the time (still
with mean µ!) might be great or terrible, depending on the application.

This module grew out of a desire for detailed benchmark timing data, plus
some additional features, which I couldn't find in existing benchmarking
modules:

=over 4

=item *

Raw timing data – I wanted to be able to get raw timing data, to allow more flexible statistical analysis of timing distributions.

=item *

Monotonic clock – I wanted times from a high-resolution monotonic clock (if available).

=item *

Setup/before/after/teardown – I wanted to be able to initialize/reset state not just once at the start, but before each iteration and without it being timed.

=item *

L<Devel::NYTProf> integration – I wanted to be able to run the B<exact> same code I benchmarked through L<Devel::NYTProf>, also limiting the profiler to the benchmark task alone, not the setup/teardown/etc. code.

=back

Eventually, I hope to add some more robust graphic visualization and