Algorithm-Classifier-IsolationForest
view release on metacpan or search on metacpan
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# perls -- see _NV_IS_DOUBLE.
sub _to_double { unpack 'd', pack 'd', $_[0] }
# ---------------------------------------------------------------------------
# Optional Inline::C accelerator for the scoring hot path.
#
# pack_input_xs(data_sv, out_sv, n_pts, n_feats, miss_mode, fill_sv)
# Walks the Perl arrayref-of-arrayrefs and writes a packed double buffer
# into out_sv. Replaces the dominant per-call Perl map-pack loop.
# miss_mode selects how an undef cell is packed: 0 => 0.0, 1 => the
# per-feature fill from fill_sv (impute), 2 => NaN (nan strategy).
#
# score_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
# n_pts, n_feats, n_trees, use_openmp)
# Sums path lengths for all n_pts query points across all n_trees trees
# in one call. Outer loop over points is OpenMP-parallel when the
# module was built with OpenMP (each iteration writes to a unique sm[i],
# so no synchronisation is needed). Tree pointers are extracted from
# the AVs before the parallel region; the parallel region touches only
# raw int / double buffers.
#
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
* caller pre-allocates with "\0" x (n_pts*n_feats*8)). Replaces
*
* pack('d*', map { my $r=$_; map { $r->[$_] // 0 } 0..$nf-1 } @$data)
*
* which was the dominant per-call overhead for high feature counts.
*
* miss_mode selects what an undef cell (or missing row) becomes:
* 0 => 0.0 (the 'die'/'zero' missing strategies)
* 1 => fill[k] (the 'impute' strategy; fill_sv is a packed
* double buffer of n_feats per-feature fill values)
* 2 => NaN (the 'nan' strategy; the C scorer's `<` / `<=`
* comparisons are both false for NaN, so a point
* missing the split feature falls to the right
* child -- matching how fit() routes it)
* fill_sv is only dereferenced when miss_mode == 1. */
void pack_input_xs(SV* data_sv, SV* out_sv, int n_pts, int n_feats,
int miss_mode, SV* fill_sv){
STRLEN tl;
double* out;
const double* fill = NULL;
double missval;
AV* outer;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
* one: switching backends never changes the model, only how fast it's
* built. (Verified by t/02-accel-selection.t's "identical seed =>
* identical trees" subtest, which exercises both backends.)
*
* Output trees are plain Perl arrayrefs in the same node shape
* _build_tree produces (leaf/axis/oblique -- see the file-top
* comment), so every downstream consumer (_pack_tree, to_json,
* from_json, the pure-Perl scorer) is unchanged.
*
* x_sv: packed row-major double buffer, n_pts rows of n_feats each
* (from pack_input_xs -- NaN marks a missing cell under the
* 'nan' missing-strategy).
* mode_flag: 0 => axis-parallel splits, 1 => oblique (extended).
* ext_level: extension_level_used (ignored when mode_flag == 0).
* out_rv: pre-existing arrayref; filled with n_trees tree roots.
* ------------------------------------------------------------------ */
/* Box-Muller normal draw, in the same rand() call order as _randn(). */
static double _c_randn(pTHX) {
double u1 = Drand01();
double u2;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
}
lo = (double*)malloc(nf * sizeof(double));
hi = (double*)malloc(nf * sizeof(double));
for (f = 0; f < nf; f++) {
lo[f] = HUGE_VAL;
hi[f] = -HUGE_VAL;
}
for (int i = 0; i < size; i++) {
const double* row = x + (size_t)idxs[i] * (size_t)nf;
/* No isnan() guard needed: NaN < x and NaN > x are always false
* under IEEE 754, so a NaN cell (the 'nan' missing strategy)
* already leaves lo/hi untouched without an explicit check --
* one less branch, and it's what lets this loop vectorize
* cleanly as a plain elementwise min/max scan. */
#ifdef _OPENMP
#pragma omp simd
#endif
for (int f2 = 0; f2 < nf; f2++) {
double v = row[f2];
if (v < lo[f2]) lo[f2] = v;
if (v > hi[f2]) hi[f2] = v;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
lo = (double*)malloc(nf * sizeof(double));
hi = (double*)malloc(nf * sizeof(double));
for (f = 0; f < nf; f++) {
lo[f] = HUGE_VAL;
hi[f] = -HUGE_VAL;
}
for (int i = 0; i < size; i++) {
const double* row = x + (size_t)idxs[i] * (size_t)nf;
/* See the matching comment in _build_node_c: no isnan() guard
* needed, since NaN < x / NaN > x are always false already --
* that's what lets this vectorize as a plain min/max scan.
* omp simd here is thread-safe to call from inside the caller's
* omp parallel region: it's a per-thread vectorization hint,
* not a team construct, so it doesn't nest into anything. */
#ifdef _OPENMP
#pragma omp simd
#endif
for (int f2 = 0; f2 < nf; f2++) {
double v = row[f2];
if (v < lo[f2]) lo[f2] = v;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$split = $lo->[$attr] + rand() * ( $hi->[$attr] - $lo->[$attr] );
} else {
# Same value, but rounded to double after each of the three ops
# exactly as the C builder computes it -- see _NV_IS_DOUBLE.
$split = _to_double( $hi->[$attr] - $lo->[$attr] );
$split = _to_double( rand() * $split );
$split = _to_double( $lo->[$attr] + $split );
}
# A point missing the split feature (nan mode only) routes to the right
# child -- the same side NaN reaches in the C scorer, where (NaN < split)
# is false. Under die/zero/impute every cell is defined, so the
# "defined($v)" guard is dead weight there and skipped entirely.
my ( @left, @right );
if ($nan) {
for my $row (@$X) {
my $v = $row->[$attr];
if ( defined($v) && $v < $split ) { push @left, $row }
else { push @right, $row }
}
} else {
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# p = lo + rand() * (hi - lo); b += c * p;
# -- see _NV_IS_DOUBLE.
my $p = _to_double( rand() * _to_double( $hi->[$f] - $lo->[$f] ) );
$p = _to_double( $lo->[$f] + $p );
push @coef, $c;
$b = _to_double( $b + _to_double( $c * $p ) );
}
} ## end for my $f (@idx)
# A point missing any feature on the hyperplane (nan mode only) routes
# to the right child: in the C scorer the dot product becomes NaN and
# (NaN <= b) is false, so this keeps fit and score consistent. Under
# die/zero/impute every cell is defined, so the per-feature "defined"
# check and early-exit are dead weight there and skipped entirely.
my ( @left, @right );
if ($nan) {
for my $row (@$X) {
my $dot = 0.0;
my $missing = 0;
for ( 0 .. $#idx ) {
my $v = $row->[ $idx[$_] ];
if ( !defined $v ) { $missing = 1; last }
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# Node layout (arrayref, slot 0 = type):
# _NODE_LEAF [0, size]
# _NODE_AXIS [1, attr, split, left, right]
# _NODE_OBLIQUE [2, \@idx, \@coef, b, left, right]
#
# The type tag is also used as a loop sentinel: 0 (_NODE_LEAF) is falsy.
# No $self argument -- the node type encodes everything needed.
#-------------------------------------------------------------------------------
# The optional $nan flag selects the nan-strategy routing: a point missing
# the split feature goes to the right child (matching the C scorer, where
# the NaN comparison is false). Without it, undef is coerced to 0 -- the
# behaviour the die/zero/impute strategies rely on (their data is dense by
# the time it reaches here, so the "// 0" is normally a no-op).
sub _path_length {
my ( $x, $node, $depth, $nan ) = @_;
while ( $node->[0] ) { # false only for leaf (type 0)
if ( $node->[0] == _NODE_AXIS ) { # [1, attr, split, left, right]
if ($nan) {
my $v = $x->[ $node->[1] ];
$node = ( defined($v) && $v < $node->[2] ) ? $node->[3] : $node->[4];
} else {
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# treated. Scoring always tolerates undef; the strategy governs fit() and
# how undef is represented for the scorer:
#
# die -- croak from fit() if the training data holds any undef cell.
# Scoring still maps undef -> 0 (the long-standing behaviour).
# zero -- undef counts as the value 0, at fit and score time.
# impute -- undef is replaced by a learned per-feature mean/median; the
# fill vector is stored on the model and reused at score time.
# nan -- ranges are built over present values only and a point missing
# the split feature is routed to the right child, consistently
# at fit (Perl) and score (C packs NaN; `<`/`<=` send it right).
# ---------------------------------------------------------------------------
# Returns the training data to actually build trees on, after applying the
# missing-value strategy. May croak (die), return a dense filled copy
# (zero/impute), or pass $data through unchanged (nan).
sub _prepare_fit_data {
my ( $self, $data ) = @_;
my $m = $self->{missing};
my $nf = $self->{n_features};
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
return [
map {
my $r = $_;
[ map { defined $r->[$_] ? $r->[$_] : $fill->[$_] } 0 .. $nf - 1 ]
} @$data
];
} ## end sub _densify
# (miss_mode, fill_packed) pair for pack_input_xs, per the active strategy.
# die/zero -> 0 (undef becomes 0.0); impute -> 1 (undef becomes fill[k]);
# nan -> 2 (undef becomes NaN, which the C scorer routes right).
sub _pack_args {
my ($self) = @_;
my $m = $self->{missing};
return ( 2, '' ) if $m eq 'nan';
if ( $m eq 'impute' ) {
my $fill = $self->{missing_fill};
croak "impute model is missing its fill vector"
unless ref $fill eq 'ARRAY' && @$fill == $self->{n_features};
$self->{_fill_packed} //= pack( 'd*', @$fill );
return ( 1, $self->{_fill_packed} );
t/80-sklearn-comparison-undef.t view on Meta::CPAN
#!perl
# 80-sklearn-comparison-undef.t
#
# Verifies consistent handling of undef (Perl) / NaN (Python) when one or
# more feature columns are missing during scoring and prediction.
#
# Perl coerces undef to 0 in numeric comparisons, so score_samples and
# predict on data with undef columns are bit-for-bit identical to the same
# calls with explicit 0 in those columns. The Python side uses
# numpy.where(isnan, 0, x) to apply the same substitution before scoring.
#
# The same battery runs against multiple datasets so the undef handling is
# exercised on more than the 2-feature case:
#
# * "2d_grid" -- 225 grid inliers + 8 outliers (2 dims); y-column undef
# * "5d_gaussian" -- 200 Gaussian inliers + 8 corner outliers (5 dims);
# 4 trailing columns undef
# * "10d_gaussian" -- same shape in 10 dims; 9 trailing columns undef
#
# For each dataset:
# 1. score_samples([x, undef, ...]) == score_samples([x, 0, ...]) exact
# 2. predict([x, undef, ...]) == predict([x, 0, ...]) exact
# 3. Spearman rho between Perl(undef→0) and sklearn(NaN→0) scores >= 0.90
# 4. Both implementations still rank the x-axis outliers above the
# inliers after the trailing columns are erased.
#
# Subtests 3 and 4 are skipped per-dataset if Python or scikit-learn is
# unavailable.
use strict;
use warnings;
use Test::More;
use List::Util qw(sum min max);
t/80-sklearn-comparison-undef.t view on Meta::CPAN
return unless defined $sk_scores;
# Perl scores for the same test points (undef → 0 coercion)
my $perl_scores;
{
local $SIG{__WARN__} = sub { };
$perl_scores = $f->score_samples( $ds->{undef_test} );
}
# ---- Subtest 3: Spearman rho between Perl and sklearn ----
subtest 'Spearman rank correlation Perl(undef->0) vs sklearn(NaN->0) >= 0.90' => sub {
my @neg_sk = map { -$_ } @$sk_scores;
my $rho = spearman_rho( $perl_scores, \@neg_sk );
cmp_ok( $rho, '>=', 0.90, sprintf( 'Spearman rho(Perl, -sklearn) = %.4f (must be >= 0.90)', $rho ) );
};
# ---- Subtest 4: outliers still separated after column erasure ----
subtest 'both agree: x-axis outliers still flagged after trailing columns erased' => sub {
my $n_in = $ds->{n_in_test};
my $n_out = $ds->{n_out_test};
t/80-sklearn-comparison-undef.t view on Meta::CPAN
cmp_ok( mean(@perl_out), '>', mean(@perl_in) + $gap_min,
sprintf( 'Perl: mean outlier score (undef cols) exceeds mean inlier score by at least %.3f', $gap_min )
);
cmp_ok( min(@perl_out), '>', max(@perl_in),
'Perl: every x-axis outlier scores strictly higher than every inlier (undef cols)' );
my @sk_in = @{$sk_scores}[ 0 .. $n_in - 1 ];
my @sk_out = @{$sk_scores}[ $n_in .. $n_in + $n_out - 1 ];
cmp_ok( mean(@sk_out), '<', mean(@sk_in),
'sklearn: mean outlier score (NaN cols) is lower (more anomalous) than mean inlier score' );
cmp_ok( max(@sk_out), '<', min(@sk_in),
'sklearn: every x-axis outlier scores strictly lower than every inlier (NaN cols)' );
}; ## end 'both agree: x-axis outliers still flagged after trailing columns erased' => sub
} ## end sub run_dataset_tests
# -----------------------------------------------------------------------
# Run the battery for each dataset
# -----------------------------------------------------------------------
for my $be (@BACKENDS) {
my ( $be_name, $USE_C ) = @$be;
for my $ds (@datasets) {
my $sk_scores = $sk_by_label && $sk_by_label->{ $ds->{label} };
( run in 0.549 second using v1.01-cache-2.11-cpan-9581c071862 )