Algorithm-Classifier-IsolationForest

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

with the library after making changes to the library and recompiling
it.  And you must show them these terms so they know their rights.

  We protect your rights with a two-step method: (1) we copyright the
library, and (2) we offer you this license, which gives you legal
permission to copy, distribute and/or modify the library.

  To protect each distributor, we want to make it very clear that
there is no warranty for the free library.  Also, if the library is
modified by someone else and passed on, the recipients should know
that what they have is not the original version, so that the original
author's reputation will not be affected by problems that might be
introduced by others.

  Finally, software patents pose a constant threat to the existence of
any free program.  We wish to make sure that a company cannot
effectively restrict the users of a free program by obtaining a
restrictive license from a patent holder.  Therefore, we insist that
any patent license obtained for a version of the library must be
consistent with the full freedom of use specified in this license.

  Most GNU software, including some libraries, is covered by the
ordinary GNU General Public License.  This license, the GNU Lesser
General Public License, applies to certain designated libraries, and
is quite different from the ordinary General Public License.  We use
this license for certain libraries in order to permit linking those
libraries into non-free programs.

  When a program is linked with a library, whether statically or using
a shared library, the combination of the two is legally speaking a
combined work, a derivative of the original library.  The ordinary
General Public License therefore permits such linking only if the
entire combination fits its criteria of freedom.  The Lesser General
Public License permits more lax criteria for linking other code with
the library.

  We call this license the "Lesser" General Public License because it
does Less to protect the user's freedom than the ordinary General
Public License.  It also provides other free software developers Less
of an advantage over competing non-free programs.  These disadvantages
are the reason we use the ordinary General Public License for many

LICENSE  view on Meta::CPAN

signed it.  However, nothing else grants you permission to modify or
distribute the Library or its derivative works.  These actions are
prohibited by law if you do not accept this License.  Therefore, by
modifying or distributing the Library (or any work based on the
Library), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Library or works based on it.

  10. Each time you redistribute the Library (or any work based on the
Library), the recipient automatically receives a license from the
original licensor to copy, distribute, link with or modify the Library
subject to these terms and conditions.  You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties with
this License.

  11. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License.  If you cannot

LICENSE  view on Meta::CPAN

through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.

This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.

  12. If the distribution and/or use of the Library is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Library under this License may add
an explicit geographical distribution limitation excluding those countries,
so that distribution is permitted only in or among countries not thus
excluded.  In such case, this License incorporates the limitation as if
written in the body of this License.

  13. The Free Software Foundation may publish revised and/or new
versions of the Lesser General Public License from time to time.
Such new versions will be similar in spirit to the present version,
but may differ in detail to address new problems or concerns.

benchmarking/BenchAccel.pm  view on Meta::CPAN

# The measurement is split into 3 equal sub-windows and the median of
# their rates is returned.  At small workloads (a few hundred
# microseconds per call) OpenMP thread scheduling is non-deterministic
# enough that a single 2-second window can land in a slow stretch and
# report ~30x lower throughput than steady state; median across
# windows smooths that without spending extra time.
sub wall_rate {
	my ( $code, $secs ) = @_;
	$secs ||= 1;

	# Warm-up: at least 0.3 s (matches the original Perl bench() helper
	# this replaced) so OpenMP thread pools are firmly hot before any
	# measurement window starts.  Scales up for long budgets -- a 30 s
	# measurement gets a 3 s warmup.
	my $warmup = $secs * 0.1;
	$warmup = 0.3 if $warmup < 0.3;
	my $wt0 = time;
	$code->() while time - $wt0 < $warmup;

	my $WINDOWS  = 3;
	my $win_secs = $secs / $WINDOWS;

benchmarking/bench-fit.pl  view on Meta::CPAN


use constant PI => 3.14159265358979;

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

# Generate $n inlier samples ($nf features each) plus ~5% outliers placed at
# radius 5-8 from the origin.
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;

examples/axis-vs-extended.pl  view on Meta::CPAN

#!/usr/bin/env perl

# axis-vs-extended.pl
#
# Isolation Forest comes in two flavours here:
#   mode => 'axis'      classic, axis-parallel splits (the original algorithm)
#   mode => 'extended'  Extended Isolation Forest, random *hyperplane* splits
#
# Axis-parallel splits can only cut straight across one feature at a time, which
# leaves a rectangular, axis-aligned bias in the score field. On data whose
# features are correlated (a diagonal band), that bias shows up two ways:
#   * points that sit off the diagonal but still inside each feature's range
#     get under-scored by axis mode, and
#   * points on the diagonal can get spuriously inflated scores.
# Extended mode, using oblique cuts, softens both effects.
#

examples/basic-anomaly-detection.pl  view on Meta::CPAN

#!/usr/bin/env perl

# basic-anomaly-detection.pl
#
# The canonical use case: fit a forest on mostly-normal data, then score and
# label every point. Here we manufacture 500 "normal" points from a Gaussian
# blob at the origin and 20 "anomalies" scattered in a ring far from it, so we
# know the ground truth and can measure how well the forest recovers it.
#
# Run from the distribution root:
#     perl -Ilib examples/basic-anomaly-detection.pl
# or, if the module is installed:
#     perl examples/basic-anomaly-detection.pl

use strict;
use warnings;
use Algorithm::Classifier::IsolationForest;

examples/online-streaming.pl  view on Meta::CPAN

#!/usr/bin/env perl

# online-streaming.pl
#
# Online (streaming) Isolation Forest on a drifting stream. The stream starts
# as a Gaussian blob at the origin, then drifts to a blob at (6, 6). An
# offline model would keep flagging the new regime forever; the online model
# forgets points as they age out of its sliding window, so within one window
# of the drift it treats the new regime as normal and the OLD regime as the
# anomaly.
#
# Points are processed prequentially (score-then-learn), the standard way to
# evaluate a streaming detector: every score reflects the model as it stood
# before that point influenced it.
#
# Run from the distribution root:

examples/online-streaming.pl  view on Meta::CPAN

	max_leaf_samples => 32,
	seed             => 42,
);

# Two probe points we re-score as the stream evolves: the centre of each
# regime.
my @probes = ( [ 0, 0 ], [ 6, 6 ] );

printf "%-28s  %-12s  %-12s\n", 'stream position', 'score(0,0)', 'score(6,6)';

# --- phase A: the stream sits at the origin ----------------------------------
$oif->score_learn( [ blob( 600, 0 ) ] );
my $s = $oif->score_samples( \@probes );
printf "%-28s  %-12.4f  %-12.4f\n", 'after 600 points at (0,0)', @$s;

# --- phase B: the stream drifts to (6, 6) ------------------------------------
# Watch the scores swap as the window turns over.
for my $chunk ( 1 .. 4 ) {
	$oif->score_learn( [ blob( 200, 6 ) ] );
	$s = $oif->score_samples( \@probes );
	printf "%-28s  %-12.4f  %-12.4f\n", "after ${\ ($chunk * 200) } points at (6,6)", @$s;

examples/save-and-load.pl  view on Meta::CPAN


# 04-save-and-load.pl
#
# Training is the expensive part; scoring is cheap. The usual pattern is to fit
# a model once, persist it, and then load it elsewhere (a cron job, a service,
# another machine) to score fresh data without retraining.
#
# The module serialises to plain JSON, so a saved model is portable and
# inspectable. This script shows both the file-based API (save/load) and the
# in-memory string API (to_json/from_json), and verifies a reloaded model scores
# identically to the original.
#
#     perl -Ilib examples/save-and-load.pl

use strict;
use warnings;
use Algorithm::Classifier::IsolationForest;
use File::Temp qw(tempfile);

use constant PI => 3.14159265358979;
srand(23);

examples/save-and-load.pl  view on Meta::CPAN

my $reloaded = Algorithm::Classifier::IsolationForest->load($path);
my $after    = $reloaded->score_samples( \@new_points );

# --- in-memory round-trip (no file) -------------------------------------------
my $json   = $model->to_json;
my $clone  = Algorithm::Classifier::IsolationForest->from_json($json);
my $cloned = $clone->score_samples( \@new_points );

# --- show that everything agrees ----------------------------------------------
print "\nScoring the same unseen points three ways:\n";
printf "  %-12s  %-10s  %-12s  %-12s\n", 'point', 'original', 'from file', 'from string';
for my $i ( 0 .. $#new_points ) {
	printf "  (%4.1f,%4.1f)  %-10.6f  %-12.6f  %-12.6f\n",
		$new_points[$i][0], $new_points[$i][1],
		$before->[$i], $after->[$i], $cloned->[$i];
}

my $identical = !grep { $before->[$_] != $after->[$_] || $before->[$_] != $cloned->[$_] } 0 .. $#new_points;

print "\nReloaded scores are ", ( $identical ? "bit-for-bit identical to the original." : "DIFFERENT (!)" ), "\n";
printf "The learned threshold survived too: %.4f -> %.4f\n", $model->decision_threshold, $reloaded->decision_threshold;

unlink $path;

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

    $iforest->set_voting('majority');
    $iforest->set_voting('mean', \@training_data);

The one thing that does not carry over is a C<contamination>-learned
L</decision_threshold>. That cutoff is a quantile of whichever per-point
quantity the mode thresholds against -- the averaged anomaly score under
C<'mean'>, the per-tree majority pivot under C<'majority'> -- and those live in
different spaces, so a threshold learned in one mode flags the wrong fraction
in the other. When the model was fitted with C<contamination>, C<set_voting>
therefore relearns the threshold for the target mode, which requires the
original training data to be passed as the second argument (the model does not
retain it). Switching a model that had no C<contamination> needs no data:
C<predict> falls back to C<0.5>, which is meaningful in both modes.

Passing the current mode is a no-op (returns immediately, no data needed).
Calling this before L</fit> just records the mode for the eventual fit.

=cut

sub set_voting {
	my ( $self, $voting, $data ) = @_;

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


	# A learned threshold only exists once a contamination-fitted model has
	# been fit(); that value is mode-specific and must be relearned against
	# the same training set (see _learn_contamination_threshold).  Everything
	# else -- pre-fit models, and fitted models without contamination -- just
	# flips the knob; predict()'s 0.5 fallback is valid in either mode.
	my $fitted      = ref $self->{trees} eq 'ARRAY' && @{ $self->{trees} };
	my $recalibrate = $fitted                       && defined $self->{contamination};
	if ($recalibrate) {
		croak "set_voting: switching a contamination-fitted model requires "
			. "the original training data as the second argument to "
			. "recalibrate the decision threshold"
			unless ref $data eq 'ARRAY' && @$data;
	}

	$self->{voting} = $voting;
	$self->_learn_contamination_threshold($data) if $recalibrate;

	return $self;
} ## end sub set_voting

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

    }

    # add some normal items
    for (1 .. 500) {
        push @data,  [ gaussian(0, 1), gaussian(0, 1) ];
        push @truth, 0;
    }
    # add some outliers
    for (1 .. 20) {
        my $angle  = rand() * 2 * PI;
        my $radius = 5 + rand() * 3;             # distance 5..8 from the origin
        push @data,  [ $radius * cos($angle), $radius * sin($angle) ];
        push @truth, 1;
    }

    $iforest->fit(\@data);

=cut

sub fit {
	my ( $self, $data ) = @_;

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

		voting          => $p->{voting} // 'mean',
		trees           => $trees,
		_use_c          => $HAS_C,
		_use_openmp     => $HAS_OPENMP,
		_use_openmp_fit => 0,                        # opt-in only; loaded models never re-fit implicitly
	};
	croak "model contains no trees" unless @{ $self->{trees} };

	# Recompute the normalising constant from the (integer, exact) sub-sample
	# size rather than trusting the stored float, so a reloaded model's scores
	# are bit-for-bit identical to the original's.
	$self->{c_psi} = _c( $self->{psi_used} ) if defined $self->{psi_used};

	my $model = bless $self, $class;
	$model->_rebuild_c_trees() if $self->{_use_c};
	return $model;
} ## end sub from_json

=head2 save($path)

Saves the model to the specified path.

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

} ## end sub _build_forest_openmp

# Inverse of _pack_tree's SoA layout: given one tree's packed node
# buffer plus the shared idx/val coefficient buffers, reconstructs the
# ordinary nested-arrayref tree structure _build_tree/_build_node_c
# produce.  li/ri fields hold the child's absolute node index, so this
# just follows them recursively from whatever index the caller says the
# root lives at.  NOTE: _pack_tree numbers nodes DFS pre-order (root at
# 0), but build_forest_openmp_xs appends nodes post-order (children
# before parent), putting the root LAST -- the caller must pass the
# right root index for the buffer's origin.
sub _unpack_node {
	my ( $nodes, $idx, $val, $node_i ) = @_;
	my $off  = $node_i * 6;
	my $type = $nodes->[$off];

	if ( $type == 0 ) {
		return [ _NODE_LEAF, int( $nodes->[ $off + 1 ] ) ];
	} elsif ( $type == 1 ) {
		my ( $attr, $split, $li, $ri )
			= @{$nodes}[ $off + 1 .. $off + 4 ];

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

sub description {
	'Generates a gaussian blob of points.

The output format is as below...

$feat1,...,$featN,$truth

$truth is a 0/1 with 1 meaning it is a abnormal value.

Normal points are drawn from N(0,1) in each dimension. Anomalous points are
placed on a hyperspherical shell at radius 5-8 from the origin.

Use -D to control the number of dimensions (default: 2).
';
} ## end sub description

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

	if ( defined( $opt->{'s'} ) && $opt->{'s'} <= 0 ) {
		$self->usage_error( '-s, "' . $opt->{'s'} . '", is less than or equal to 0, should be a positive int' );

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


sub description {
	'Switches the scoring-time aggregation of a saved model between "mean" and
"majority" and writes it back (in place over -m by default, or to -o / stdout).

The forest itself is voting-independent, so no tree is rebuilt. The one thing
that does not carry over is a contamination-learned decision threshold: it is a
quantile of whichever per-point quantity the mode thresholds against (the
averaged anomaly score under mean, the per-tree majority pivot under majority),
so switching relearns it for the target mode. That recalibration needs the
original training data, supplied as a CSV via -i. Models fit without
contamination carry no threshold and switch without -i.

Switches to new args are like below...

--voting -> voting
-i       -> training CSV (contamination models only)

';
} ## end sub description

lib/Algorithm/Classifier/IsolationForest/Online.pm  view on Meta::CPAN

###

sub _check_learned {
	my ($self) = @_;
	croak "model has not learned any data yet; call learn() first"
		unless $self->{seen} > 0;
}

# Validate one incoming sample, apply the missing-value strategy, and
# return a fresh dense copy (the window owns its rows; the caller may
# reuse or mutate the original).  Locks in n_features on first contact.
sub _prep_row {
	my ( $self, $row, $caller ) = @_;
	croak "$caller: each sample must be an arrayref of features"
		unless ref $row eq 'ARRAY' && @$row;

	if ( !defined $self->{n_features} ) {
		$self->{n_features} = scalar @$row;
	} elsif ( scalar @$row != $self->{n_features} ) {
		croak "$caller: sample has " . scalar(@$row) . " features but model expects " . $self->{n_features};
	}

lib/Algorithm/Classifier/IsolationForest/Online.pm  view on Meta::CPAN

		push @c_coef_idx, $empty_idx;
		push @c_coef_val, $empty_val;
	}
	$self->{_c_nodes}    = \@c_nodes;
	$self->{_c_coef_idx} = \@c_coef_idx;
	$self->{_c_coef_val} = \@c_coef_val;
	return 1;
} ## end sub _ensure_c_trees

# Flatten one live tree into the parent's packed node buffer (DFS
# pre-order, root at index 0 -- the origin score_all_xs walks from).
sub _pack_online_tree {
	my ( $self, $root ) = @_;

	# A tree that has not learned anything walks as depth 0 with a zero
	# adjustment: one empty leaf record.
	return pack( 'd*', 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) unless defined $root;

	my @node_data;
	my $assign;
	$assign = sub {

t/32-pack-data.t  view on Meta::CPAN

#!perl
# 32-pack-data.t
#
# Verifies pack_data + accept-packed semantics on the five scoring
# methods: passing the PackedData wrapper produces the same results
# as passing the original arrayref, on the same model.

use strict;
use warnings;
use Test::More;
use List::Util qw(sum);

use Algorithm::Classifier::IsolationForest;

my $CLASS = 'Algorithm::Classifier::IsolationForest';

t/33-parallel-fit.t  view on Meta::CPAN


	my $json = $f1->to_json;
	ok( length $json > 100, 'JSON has plausible body length' );

	my $f2 = $CLASS->from_json($json);
	is( scalar @{ $f2->{trees} }, 25, 'restored tree count matches' );

	my $s1    = $f1->score_samples( \@query );
	my $s2    = $f2->score_samples( \@query );
	my $diffs = grep { abs( $s1->[$_] - $s2->[$_] ) > 1e-9 } 0 .. $#$s1;
	is( $diffs, 0, 'restored model produces the same scores as the parallel-fit original' );
}; ## end 'parallel_fit + to_json/from_json round-trips' => sub

subtest 'parallel_fit with n_trees < workers caps workers at n_trees' => sub {
	plan skip_all => 'no fork() on this platform' unless $can_fork;

	# 3 trees, 8 workers requested -- only 3 workers should actually fork.
	my $f = $CLASS->new(
		n_trees      => 3,
		sample_size  => 64,
		seed         => 23,

t/34-missing-values.t  view on Meta::CPAN

			);
			$f->fit( \@holey );
			my $reloaded = $CLASS->from_json( $f->to_json );

			is( $reloaded->{missing}, $strategy, "$strategy: missing restored" );
			if ( $strategy eq 'impute' ) {
				is_deeply( $reloaded->{missing_fill}, $f->{missing_fill}, 'impute: fill vector restored' );
			}

			cmp_ok( _max_abs_diff( $f->score_samples( \@test ), $reloaded->score_samples( \@test ) ),
				'<', 1e-9, "$strategy: reloaded scores match original" );
		} ## end for my $cfg ( [ zero => {} ], [ impute => {...}])
	}; ## end "[$be_name] save/load round-trips each strategy" => sub

	# -----------------------------------------------------------------------
	# Old models (no `missing` key) load as zero and keep undef -> 0 scoring
	# -----------------------------------------------------------------------
	subtest "[$be_name] pre-missing models default to zero on load" => sub {
		my $f    = $CLASS->new( n_trees => 40, seed => $SEED, use_c => $USE_C )->fit( \@clean );
		my $json = $f->to_json;

t/37-majority-voting.t  view on Meta::CPAN

	$sw->set_voting( 'mean', \@data );
	cmp_ok( abs( $sw->decision_threshold - $mean_thr ),
		'<', 1e-12, 'switching back to mean restores the mean-mode threshold' );

	# A no-op switch needs no data and returns self.
	is( $sw->set_voting('mean'), $sw, 'switching to the current mode is a no-op returning $self' );

	# A contamination-fitted model refuses to switch without the data.
	my $need = $CLASS->new( %args, voting => 'majority' )->fit( \@data );
	eval { $need->set_voting('mean') };
	like( $@, qr/requires the original training data/, 'contamination model croaks without data' );
	is( $need->{voting}, 'majority', 'mode unchanged after the croak' );

	# A model with no contamination switches freely, no data required.
	my $free = $CLASS->new( n_trees => 50, sample_size => 32, seed => 7, voting => 'mean' )->fit( \@data );
	$free->set_voting('majority');
	is( $free->{voting},           'majority', 'non-contamination model switches without data' );
	is( $free->decision_threshold, undef,      'no threshold to recalibrate when contamination was never set' );

	# Invalid values are rejected.
	eval { $free->set_voting('plurality') };

t/80-sklearn-comparison-online.t  view on Meta::CPAN


# Assign 1-based ranks; lower value gets lower rank.
sub _assign_ranks {
	my @v   = @_;
	my @idx = sort { $v[$a] <=> $v[$b] } 0 .. $#v;
	my @r;
	$r[ $idx[$_] ] = $_ + 1 for 0 .. $#idx;
	return @r;
}

# Pearson correlation of two rank vectors (= Spearman rho of the originals).
sub spearman_rho {
	my ( $xs, $ys ) = @_;
	my @rx = _assign_ranks(@$xs);
	my @ry = _assign_ranks(@$ys);
	my $n  = scalar @rx;
	my ( $sa, $sb, $saa, $sbb, $sab ) = (0) x 5;
	for my $i ( 0 .. $n - 1 ) {
		$sa  += $rx[$i];
		$sb  += $ry[$i];
		$saa += $rx[$i]**2;

t/80-sklearn-comparison-undef.t  view on Meta::CPAN

#   n_in_test  -- number of leading inlier-like test rows
#   n_out_test -- number of trailing outlier-like test rows
#   mean_gap_min -- lower bound for mean(outlier) - mean(inlier) Perl scores.
#                   Set per-dataset because the gap shrinks as nf grows:
#                   trees that don't split on the lone signal column treat
#                   inlier-like and outlier-like test points identically, so
#                   their contribution to the score is the same.  Ordering
#                   (min/max separation) still holds in every dimension.
# -----------------------------------------------------------------------

# 2D regular grid + corner/axis outliers (the original undef dataset).
sub make_2d_grid_dataset {
	my @inliers;
	for my $i ( -7 .. 7 ) {
		for my $j ( -7 .. 7 ) {
			push @inliers, [ $i / 7.0, $j / 7.0 ];
		}
	}
	my @outliers = ( [ 6, 6 ], [ -6, 6 ], [ 6, -6 ], [ -6, -6 ], [ 0, 8 ], [ 8, 0 ], [ -8, 0 ], [ 0, -8 ] );
	my ( $undef_test, $zero_test ) = make_undef_test_points(2);
	return {

t/80-sklearn-comparison-undef.t  view on Meta::CPAN

		n_feat       => 2,
		train        => [ @inliers, @outliers ],
		undef_test   => $undef_test,
		zero_test    => $zero_test,
		n_in_test    => 19,
		n_out_test   => 6,
		mean_gap_min => 0.20,
	};
} ## end sub make_2d_grid_dataset

# N-D Gaussian inliers + corner outliers far from origin in every axis.
# Test points still only carry signal in column 0; the other nf-1 columns
# are undef.  Seeded deterministically per dimension.
sub make_nd_gaussian_dataset {
	my ($nf) = @_;
	srand( 20260629 + $nf );

	my @inliers;
	push @inliers, [ map { gaussian( 0, 0.3 ) } 1 .. $nf ] for 1 .. 200;

	my @outliers;

t/80-sklearn-comparison.t  view on Meta::CPAN


# Assign 1-based ranks; lower value gets lower rank.
sub _assign_ranks {
	my @v   = @_;
	my @idx = sort { $v[$a] <=> $v[$b] } 0 .. $#v;
	my @r;
	$r[ $idx[$_] ] = $_ + 1 for 0 .. $#idx;
	return @r;
}

# Pearson correlation of two rank vectors (= Spearman rho of the originals).
sub spearman_rho {
	my ( $xs, $ys ) = @_;
	my @rx = _assign_ranks(@$xs);
	my @ry = _assign_ranks(@$ys);
	my $n  = scalar @rx;
	my ( $sa, $sb, $saa, $sbb, $sab ) = (0) x 5;
	for my $i ( 0 .. $n - 1 ) {
		$sa  += $rx[$i];
		$sb  += $ry[$i];
		$saa += $rx[$i]**2;

t/80-sklearn-comparison.t  view on Meta::CPAN

#   label    -- short identifier (used as Python output key + subtest name)
#   n_feat   -- feature count
#   inliers  -- arrayref of inlier rows
#   outliers -- arrayref of outlier rows
#   data     -- inliers followed by outliers (order matters: tests index by
#               position to pick out outliers in the combined score vector)
#   n_in     -- scalar @inliers
#   n_out    -- scalar @outliers
# -----------------------------------------------------------------------

# 2D regular grid + corner/axis outliers (the original dataset).
sub make_2d_grid_dataset {
	my @inliers;
	for my $i ( -7 .. 7 ) {
		for my $j ( -7 .. 7 ) {
			push @inliers, [ $i / 7.0, $j / 7.0 ];
		}
	}
	my @outliers = ( [ 6, 6 ], [ -6, 6 ], [ 6, -6 ], [ -6, -6 ], [ 0, 8 ], [ 8, 0 ], [ -8, 0 ], [ 0, -8 ] );
	return {
		label    => '2d_grid',
		n_feat   => 2,
		inliers  => \@inliers,
		outliers => \@outliers,
		data     => [ @inliers, @outliers ],
		n_in     => scalar @inliers,
		n_out    => scalar @outliers,
	};
} ## end sub make_2d_grid_dataset

# N-D Gaussian inliers + corner-style outliers far from origin in every axis.
# Deterministic via a fixed srand seed derived from the dimension.
sub make_nd_gaussian_dataset {
	my ($nf) = @_;
	srand( 20260629 + $nf );

	my @inliers;
	push @inliers, [ map { gaussian( 0, 0.3 ) } 1 .. $nf ] for 1 .. 200;

	# Outliers: each coordinate at magnitude 5..8 with random sign so the
	# point sits at a "corner" of the bounding box, well outside the inlier

t/90-cli-commands.t  view on Meta::CPAN

# --- 1. Generate a tiny CSV training dataset ----------------------------
my $train_csv = "$tmp/train.csv";
my $query_csv = "$tmp/query.csv";
my $model     = "$tmp/model.json";
my $packed    = "$tmp/query.packed";
my $pred_csv  = "$tmp/pred.csv";
my $pred2_csv = "$tmp/pred2.csv";

{
	open my $fh, '>', $train_csv or die $!;
	# 50 inliers around the origin + 3 outliers far away (3 features).
	srand(1);
	for ( 1 .. 50 ) {
		print $fh join( ',', map { sprintf( '%.4f', rand() - 0.5 ) } 1 .. 3 ), "\n";
	}
	print $fh "8,8,8\n-7,-7,-7\n7,-7,7\n";
	close $fh;
}
{
	open my $fh, '>', $query_csv or die $!;
	# 5 inliers + 2 outliers.



( run in 1.205 second using v1.01-cache-2.11-cpan-9581c071862 )