File Coverage

blib/lib/Dumbbench.pm

Criterion	Covered	Total	%
statement	108	144	75.0
branch	36	72	50.0
condition	8	22	36.3
subroutine	13	16	81.2
pod	6	9	66.6
total	171	263	65.0

package Dumbbench;
use strict;
use warnings;
use Carp ();
use Time::HiRes ();

our $VERSION = '0.503';

require Dumbbench::Result;
require Dumbbench::Stats;
require Dumbbench::Instance;

use Params::Util '_INSTANCE';

use Class::XSAccessor {
  getters => [qw(
    target_rel_precision
    target_abs_precision
    initial_runs
    max_iterations
    variability_measure
    started
    outlier_rejection
    subtract_dry_run
  )],
  accessors => [qw(verbosity)],
};


sub new {
  my $proto = shift;
  my $class = ref($proto)||$proto;
  my $self;
  if (not ref($proto)) {
    $self = bless {
      verbosity            => 0,
      target_rel_precision => 0.05,
      target_abs_precision => 0,
      initial_runs         => 20,
      max_iterations       => 10000,
      variability_measure  => 'mad',
      instances            => [],
      started              => 0,
      outlier_rejection    => 3,
      subtract_dry_run     => 1,
      @_,
    } => $class;
  }
  else {
    $self = bless {%$proto, @_} => $class;
    my @inst = $self->instances;
    $self->{instances} = [];
    foreach my $instance (@inst) {
      push @{$self->{instances}}, $instance->new;
    }
  }

  if ($self->target_abs_precision <= 0 and $self->target_rel_precision <= 0) {
    Carp::croak("Need either target_rel_precision or target_abs_precision > 0");
  }
  if ($self->initial_runs < 6) {
    Carp::carp("Number of initial runs is very small (<6). Precision will be off.");
  }

  return $self;
}

sub add_instances {
  my $self = shift;

  if ($self->started) {
    Carp::croak("Can't add instances after the benchmark has been started");
  }
  foreach my $instance (@_) {
    if (not _INSTANCE($instance, 'Dumbbench::Instance')) {
      Carp::croak("Argument to add_instances is not a Dumbbench::Instance");
    }
  }
  push @{$self->{instances}}, @_;
}

sub instances {
  my $self = shift;
  return @{$self->{instances}};
}

sub run {
  my $self = shift;
  Carp::croak("Can't re-run same benchmark instance") if $self->started;
  $self->dry_run_timings if $self->subtract_dry_run;
  $self->run_timings;
}

sub run_timings {
  my $self = shift;
  $self->{started} = 1;
  foreach my $instance ($self->instances) {
    next if $instance->result;
    $self->_run($instance);
  }
}

sub dry_run_timings {
  my $self = shift;
  $self->{started} = 1;

  foreach my $instance ($self->instances) {
    next if $instance->dry_result;
    $self->_run($instance, 'dry');
  }
}

sub _run {
  my $self = shift;
  my $instance = shift;
  my $dry = shift;

  my $name = $instance->_name_prefix;

  # for overriding in case of dry-run mode
  my $V = $self->verbosity || 0;
  my $initial_timings = $self->initial_runs;
  my $abs_precision = $self->target_abs_precision;
  my $rel_precision = $self->target_rel_precision;
  my $max_iterations = $self->max_iterations;

  if ($dry) {
    $V--; $V = 0 if $V < 0;
    $initial_timings *= 5;
    $abs_precision    = 0;
    $rel_precision   /= 2;
    $max_iterations  *= 10;
  }

  print "${name}Running initial timing for warming up the cache...\n" if $V;
  if ($dry) {
    # be generous, this is fast
    $instance->single_dry_run() for 1..3;
  }
  else {
    $instance->single_run();
  }

  my @timings;
  print "${name}Running $initial_timings initial timings...\n" if $V;
  foreach (1..$initial_timings) {
    print "${name}Running timing $_...\n" if $V > 1;
    push @timings, ($dry ? $instance->single_dry_run() : $instance->single_run());
  }

  print "${name}Iterating until target precision reached...\n" if $V;

  my $stats = Dumbbench::Stats->new(data => \@timings);
  my $sigma;
  my $mean;

#My mental model for the distribution was Gauss+outliers.
#If my expectation is correct, the following algorithm should produce a reasonable EV +/- uncertainty:
#1) Calc. median of the whole distribution.
#2) Calculate the median-absolute deviation from the whole distribution (MAD, see wikipedia). It needs rescaling to become a measure of variability that is robust against outliers.
#(The MAD will be our initial guess for a "sigma")
#3) Reject the samples that are outside $median +/- $n*$MAD.
#I was expecting several high outliers but few lows. An ordinary truncated mean or the like would be unsuitable for removing the outliers in such a case since you'd get a significant upward bias of your EV.
#By using the median as the initial guess, we keep the initial bias to a minimum. The MAD will be similarly unaffected by outliers AND the asymmetry.
#Thus cutting the tails won't blow up the bias too strongly (hopefully).
#4) Calculate mean & MAD/sqrt($n) of the remaining distribution. These are our EV and uncertainty on the mean.

  my $n_good = 0;
  my $variability_measure = $self->variability_measure;
  while (1) {
    my ($good, $outliers) = $stats->filter_outliers(
      variability_measure => $variability_measure,
      nsigma_outliers     => $self->outlier_rejection,
    );

    $n_good = @$good;

    if (not $n_good and @timings >= $max_iterations) {
      $mean = 0; $sigma = 0;
      last;
    }

    if ($n_good) {
      my $new_stats = Dumbbench::Stats->new(data => $good);
      $sigma = $new_stats->$variability_measure() / sqrt($n_good);
      $mean = $new_stats->mean();

      # stop condition
      my $need_iter = 0;
      if ($rel_precision > 0) {
        my $rel = $sigma/$mean;
        print "${name}Reached relative precision $rel (neeed $rel_precision).\n" if $V > 1;
        $need_iter++ if $rel > $rel_precision;
      }
      if ($abs_precision > 0) {
        print "${name}Reached absolute precision $sigma (neeed $abs_precision).\n" if $V > 1;
        $need_iter++ if $sigma > $abs_precision;
      }
      if ($n_good < $initial_timings) {
        $need_iter++;
      }
      last if not $need_iter or @timings >= $max_iterations;
    }

    # progressively run more new timings in one go. Otherwise,
    # we start to stall on the O(n*log(n)) complexity of the median.
    my $n = List::Util::min( $max_iterations - @timings, List::Util::max(1, @timings*0.05) );
    push @timings, ($dry ? $instance->single_dry_run() : $instance->single_run()) for 1..$n;
  } # end while more data required

  if (@timings >= $max_iterations and not $dry) {
    print "${name}Reached maximum number of iterations. Stopping. Precision not reached.\n";
  }

  # rescale sigma
  # This is necessary since by cutting everything outside of n-sigma,
  # we artificially reduce the variability of the main distribution.
  if ($self->outlier_rejection) {
    # TODO implement
  }

  my $result = Dumbbench::Result->new(
    timing      => $mean,
    uncertainty => $sigma,
    nsamples    => $n_good,
  );

  if ($dry) {
    $instance->{dry_timings} = \@timings;
    $instance->dry_result($result);
  }
  else {
    $instance->{timings} = \@timings;
    $result -= $instance->dry_result
      if defined $instance->dry_result and $self->subtract_dry_run;
    $instance->result($result);
  }
}

sub report {
  my ( $self, $raw, $options ) = @_;
  $options ||= {};
  Carp::carp( "The second option to report was not a hash ref" )
    unless ref $options eq ref {};

  foreach my $instance ($self->instances) {
    my $result = $instance->result;
    my $result_str = ($options->{float}) ? unscientific_notation($result) : "$result";

    if (not $raw) {
      my $mean = $result->raw_number;
      my $sigma = $result->raw_error->[0];
      my $name = $instance->_name_prefix;
      printf(
        "%sRan %u iterations (%u outliers).\n",
        $name,
        scalar(@{$instance->timings}),
        scalar(@{$instance->timings})-$result->nsamples
      );
      printf(
        "%sRounded run time per iteration (seconds): %s (%.1f%%)\n",
        $name,
        $result_str,
        $sigma/$mean*100
      );
      if ($self->verbosity) {
        printf("%sRaw:                            $mean +/- $sigma\n", $name);
      }
    }
    else {
      print $result_str, "\n";
    }
  }
}

sub box_plot {
  my $self = shift;
  require Dumbbench::BoxPlot;

  return Dumbbench::BoxPlot->new($self);
}

sub unscientific_notation {
  sprintf( "%f %s %f", split( / /, $_[0] ) );
}

1;

__END__