view release on metacpan or  search on metacpan

lib/Algorithm/Classifier/IsolationForest/App/Command/bench.pm  view on Meta::CPAN

package Algorithm::Classifier::IsolationForest::App::Command::bench;

use strict;
use warnings;
use Algorithm::Classifier::IsolationForest ();
use Algorithm::Classifier::IsolationForest::App -command;
use File::Slurp  qw(read_file);
use Scalar::Util qw(looks_like_number);
use Time::HiRes  qw(time);

sub opt_spec {
	return (
		[
			'm=s',
			'Input model JSON file path/name.',
			{ 'default' => 'iforest_model.json', 'completion' => 'files' }
		],
		[ 'i=s',      'Input CSV (rows of features to score).',          { 'completion' => 'files' } ],
		[ 'secs|s=f', 'Seconds per measurement (after a 0.3s warm-up).', { 'default'    => 2 } ],
		[ 't=f',      'Threshold to use for predict / score_predict_*.', { 'default'    => 0.5 } ],
	);
} ## end sub opt_spec

sub abstract { 'Measure scoring throughput of a saved model on a CSV dataset' }

sub description {
	'Loads a model and a CSV dataset, then times each of the
public scoring methods over the configured wall-clock budget.  Reports
ops-per-second for each.

When the Inline::C backend is active the bench also runs pack_data once
up front and times the *_packed variants so users can see how much
pre-packing saves on their workload.

Use this to answer:

  * is my Inline::C / OpenMP / SIMD build actually faster than the
    pure-Perl fallback?
  * how much does pack_data help on my data shape?
  * what is the per-call throughput I can expect at production-typical
    query-set sizes?
';
} ## end sub description

sub validate {
	my ( $self, $opt, $args ) = @_;

	if ( !defined $opt->{'i'} ) {
		$self->usage_error('-i has not been specified');
	} elsif ( !-f $opt->{'i'} ) {
		$self->usage_error( '-i, "' . $opt->{'i'} . '", is not a file or does not exist' );
	} elsif ( !-r $opt->{'i'} ) {
		$self->usage_error( '-i, "' . $opt->{'i'} . '", is not readable' );
	}

	if ( !-f $opt->{'m'} ) {
		$self->usage_error( '-m, "' . $opt->{'m'} . '", is not a file or does not exist' );
	} elsif ( !-r $opt->{'m'} ) {
		$self->usage_error( '-m, "' . $opt->{'m'} . '", is not readable' );
	}

	if ( $opt->{'secs'} <= 0 ) {
		$self->usage_error('--secs must be > 0');
	}

	if ( $opt->{'t'} <= 0 || $opt->{'t'} >= 1 ) {
		$self->usage_error('-t must satisfy 0 < t < 1');
	}

	return 1;
} ## end sub validate

# Standard bench helper: warm up briefly, then time exactly $secs of
# back-to-back calls.  Returns ops/second.
sub _bench {
	my ( $code, $secs ) = @_;
	my $t0 = time();
	$code->() while time() - $t0 < 0.3;
	$t0 = time();
	my $n = 0;
	$code->(), $n++ while time() - $t0 < $secs;
	return $n / ( time() - $t0 );
}

sub _read_csv {
	my ($path) = @_;
	my @data;
	my $expected;