view release on metacpan or  search on metacpan

benchmarking/bench-sklearn-scoring.pl  view on Meta::CPAN

#!/usr/bin/perl
# benchmarking/bench-sklearn-scoring.pl
#
# Compares scoring throughput among three Perl backends and scikit-learn's
# IsolationForest across two axes:
#   * query-set size       (fixed feature count)
#   * feature-vector width (fixed query-set size)
#
# Perl backends benchmarked (when available):
#   pure perl   -- no Inline::C  (use_c => 0)
#   C serial    -- Inline::C, single-threaded  (use_c => 1, use_openmp => 0)
#   C+OpenMP    -- Inline::C + OpenMP parallel (use_c => 1, use_openmp => 1)
#
# The same training CSV and query CSVs are used by all sides so the
# comparison is on identical data.  Models are pre-trained before any
# timing starts.
#
# Method correspondence:
#   Perl score_samples         <-->  clf.score_samples(X)      (same formula, opposite sign)
#   Perl predict               <-->  clf.predict(X)            (same semantics, 0/1 vs -1/+1)
#   Perl score_predict_samples <-->  (no sklearn equivalent)
#   Perl score_predict_split   <-->  (no sklearn equivalent)
#   Perl path_lengths          <-->  (no sklearn equivalent)
#   (no Perl equivalent)       <-->  clf.decision_function(X)  (threshold-shifted score)
#
# The ratio column shows sklearn ops/s / best-Perl ops/s.
# >1 means sklearn is faster; <1 means Perl is faster.
#
# Unavailable backends (Inline::C not installed, OpenMP not linked,
# scikit-learn not installed) are omitted from the table.
#
# Run with:
#   perl -Ilib benchmarking/bench-sklearn-scoring.pl

use strict;
use warnings;
use lib '../lib';
use FindBin;
use lib "$FindBin::Bin";
use BenchAccel qw(wall_rate);
use File::Temp qw(tempfile);
use JSON::PP   ();
use Algorithm::Classifier::IsolationForest;

use constant PI => 3.14159265358979;

my $HAS_C      = $Algorithm::Classifier::IsolationForest::HAS_C;
my $HAS_OPENMP = $Algorithm::Classifier::IsolationForest::HAS_OPENMP;

# -----------------------------------------------------------------------
# Data generation
# -----------------------------------------------------------------------
sub gaussian {
	my ( $mu, $sigma ) = @_;
	return $mu + $sigma * sqrt( -2 * log( rand() || 1e-12 ) ) * cos( 2 * PI * rand() );
}

sub make_data {
	my ( $n, $nf ) = @_;
	my @rows = map {
		[ map { gaussian( 0, 1 ) } 1 .. $nf ]
	} 1 .. $n;
	for ( 1 .. int( $n * 0.05 ) ) {
		my $r = 5 + rand() * 3;
		push @rows, [ map { $r * ( rand() > 0.5 ? 1 : -1 ) } 1 .. $nf ];
	}
	return \@rows;
} ## end sub make_data

# -----------------------------------------------------------------------
# Parameters
# -----------------------------------------------------------------------
my $N_TRAIN    = 1000;
my $N_FEATURES = 2;      # used for the query-size sweep
my $N_TREES    = 100;
my $PSI        = 256;
my $BENCH_SECS = 2;

my @query_sizes        = ( 100, 500, 1_000, 5_000, 10_000 );
my @feature_sizes      = ( 2,   5,   10,    25,    50, 100 );
my $FEATURE_QUERY_SIZE = 1_000;

# -----------------------------------------------------------------------
# Helpers for building experiments
# -----------------------------------------------------------------------
sub write_csv {

benchmarking/bench-sklearn-scoring.pl  view on Meta::CPAN

# -----------------------------------------------------------------------

# Row layout: [ label, pure_key, c_key, omp_key, sklearn_key ]
# undef means "not applicable for this backend/side"
my @rows = (
	[ 'score_samples',          'score_samples', 'score_samples',        'score_samples',        'score_samples' ],
	[ 'score_samples (packed)', undef,           'score_samples_packed', 'score_samples_packed', undef ],
	[ 'predict',                'predict',       'predict',              'predict',              'predict' ],
	[ 'predict (packed)',       undef,           'predict_packed',       'predict_packed',       undef ],
	[ 'score_predict_samples',  'score_predict_samples', 'score_predict_samples', 'score_predict_samples',      undef ],
	[ 'score_predict_split',    'score_predict_split',   'score_predict_split',   'score_predict_split',        undef ],
	[ 'score_predict_split (packed)', undef, 'score_predict_split_packed',        'score_predict_split_packed', undef ],
	[ 'path_lengths',                 'path_lengths', 'path_lengths',             'path_lengths', undef ],
	[ 'decision_function',            undef,          undef,                      undef,          'decision_function' ],
);

my $MW = 28;    # method column width
my $NW = 12;    # numeric backend column width
my $SW = 14;    # sklearn column width
my $RW = 8;     # ratio column width

sub fmt_rate { defined $_[0] && $_[0] ? sprintf( '%.1f', $_[0] ) : '--' }

sub print_point {
	my ($key) = @_;

	# Header row
	my @hdr = ( sprintf( "  %-*s", $MW, 'method' ) );
	push @hdr, sprintf( "  %*s", $NW, 'perl (ops/s)' );
	push @hdr, sprintf( "  %*s", $NW, 'C (ops/s)' )      if $HAS_C;
	push @hdr, sprintf( "  %*s", $NW, 'C+OMP(ops/s)' )   if $HAS_OPENMP;
	push @hdr, sprintf( "  %*s", $SW, 'sklearn(ops/s)' ) if defined $sk;
	push @hdr, sprintf( "  %*s", $RW, 'ratio' )          if defined $sk;
	print join( '', @hdr ), "\n";

	# Separator row
	my @sep = ( '  ' . '-' x $MW );
	push @sep, '  ' . '-' x $NW;
	push @sep, '  ' . '-' x $NW if $HAS_C;
	push @sep, '  ' . '-' x $NW if $HAS_OPENMP;
	push @sep, '  ' . '-' x $SW if defined $sk;
	push @sep, '  ' . '-' x $RW if defined $sk;
	print join( '', @sep ), "\n";

	for my $row (@rows) {
		my ( $label, $pure_key, $c_key, $omp_key, $sk_key ) = @$row;

		# Skip rows where every available column would show '--'
		next
			unless $pure_key
			|| ( $c_key   && $HAS_C )
			|| ( $omp_key && $HAS_OPENMP )
			|| ( $sk_key  && $sk );

		my $pure_rate = $pure_key                   ? $pure_pl{$key}{$pure_key} : undef;
		my $c_rate    = ( $c_key && $HAS_C )        ? $c_pl{$key}{$c_key}       : undef;
		my $omp_rate  = ( $omp_key && $HAS_OPENMP ) ? $omp_pl{$key}{$omp_key}   : undef;
		my $sk_rate   = ( $sk_key && $sk )          ? $sk->{$key}{$sk_key}      : undef;

		# Best available Perl rate for the ratio denominator
		my $best = $omp_rate // $c_rate // $pure_rate;

		my @cols = ( sprintf( "  %-*s", $MW, $label ) );
		push @cols, sprintf( "  %*s", $NW, fmt_rate($pure_rate) );
		push @cols, sprintf( "  %*s", $NW, fmt_rate($c_rate) )   if $HAS_C;
		push @cols, sprintf( "  %*s", $NW, fmt_rate($omp_rate) ) if $HAS_OPENMP;

		if ( defined $sk ) {
			push @cols, sprintf( "  %*s", $SW, fmt_rate($sk_rate) );
			my $ratio = ( $best && $sk_rate ) ? sprintf( '%.2f', $sk_rate / $best ) : '--';
			push @cols, sprintf( "  %*s", $RW, $ratio );
		}

		print join( '', @cols ), "\n";
	} ## end for my $row (@rows)
	print "\n";
} ## end sub print_point

# -----------------------------------------------------------------------
# Banner
# -----------------------------------------------------------------------
my $TW
	= 2 + $MW + 2 + $NW
	+ ( $HAS_C      ? 2 + $NW           : 0 )
	+ ( $HAS_OPENMP ? 2 + $NW           : 0 )
	+ ( defined $sk ? 2 + $SW + 2 + $RW : 0 );

my $backends = 'pure-Perl' . ( $HAS_C ? ', C serial' : '' ) . ( $HAS_OPENMP ? ', C+OpenMP' : '' );

print '=' x $TW, "\n";
printf " Perl (%s) vs scikit-learn -- scoring speed (ops/s)\n", $backends;
print '=' x $TW, "\n";
printf " Training: %d samples, n_trees=%d, sample_size=%d\n", $N_TRAIN, $N_TREES, $PSI;
printf " Each measurement: %.0fs wall-clock with warmup\n", $BENCH_SECS;
print " ratio = sklearn ops/s / best-Perl ops/s  (>1 = sklearn faster)\n";
print " --  = no equivalent or backend not available\n";
print " packed = pre-packed input (skips per-call AoA walk; C backend only)\n";
print "\n";

unless ( defined $sk ) {
	print " (scikit-learn not available; showing Perl results only)\n\n";
}

# ---- Query-size sweep -----------------------------------------------
print '#' x $TW, "\n";
printf "# Query-size sweep (features fixed at %d)\n", $N_FEATURES;
print '#' x $TW, "\n";
for my $exp ( grep { $_->{sweep} eq 'qsize' } @experiments ) {
	printf "--- %d query points ---\n", $exp->{label};
	print_point( exp_key($exp) );
}

# ---- Feature-dimension sweep ----------------------------------------
print '#' x $TW, "\n";
printf "# Feature-dimension sweep (query size fixed at %d)\n", $FEATURE_QUERY_SIZE;
print '#' x $TW, "\n";
for my $exp ( grep { $_->{sweep} eq 'features' } @experiments ) {
	printf "--- %d features ---\n", $exp->{label};
	print_point( exp_key($exp) );
}