Algorithm-Classifier-IsolationForest
view release on metacpan or search on metacpan
- Implement named features and methods for testing single rows using
tagged data.
- The C backend can be built and installed at install time, meaning
nothing needs built unless changing the opts. See the docs for
more details.
- new IF_NO_OPENMP=1 selects/builds the serial C backend: no
libgomp linkage and no OpenMP runtime in the process at all
(unlike OMP_NUM_THREADS=1, which just caps the thread count);
IF_NO_OPENMP=0 re-enables OpenMP over a serial install default
- new IF_RUNTIME_BUILD=1 ignores the prebuilt object and forces
the classic runtime build even when the flags match
- iforest accel updated to reflect various changes to the C backend
- scoring: the per-leaf path-length adjustment c(size) is now
precomputed at tree-pack time and stored in the (previously
unused) third slot of packed leaf records, removing a log()
call per point per tree from the C scoring hot loop -- about
25% faster axis-mode scoring; results are bit-identical
- scoring: score_all_xs now picks between two loop shapes based
on total forest size: small forests keep the point-major loop
(whole forest stays cache-resident anyway), while forests
over 4 MB switch to a tree-blocked loop that walks a block of
right child, consistently at fit and score time
- new `impute_with => 'mean'|'median'` option for impute mode ...
missing strategy + impute fill vector are persisted in saved models;
models from older releases load as `zero` (the prior undef -> 0
scoring behaviour)
- the C build is now tunable via environment variables read at first
module load: IF_ARCH=<value> adds -march=<value>, IF_NATIVE=1 is
shorthand for IF_ARCH=native, IF_OPT overrides the default -O3,
and IF_NO_C=1 skips building the C backend entirely; values are
validated (bad ones warn and fall back to the defaults) and the
flags actually used are exposed via $OPT_LEVEL
- Benchmarking: bench-sklearn-scoring.pl now compares pure Perl, C,
and C+OpenMP fit/score paths against sklearn side by side
0.2.1 2026-06-30/14:30
- derp... actually update MANIFEST so a bunch of files from last release
are actually included
0.2.0 2026-06-30/14:15
- C acceleration via Inline::C for core fit and predict ops
- OpenMP support for parallel multi-threaded fitting and predict ops
- SIMD (AVX/SSE) acceleration where available
- Data packing support for compact model storage (new `pack` CLI command)
- Parallel fit capability
- New `score_predict_split` method
- New `accel` CLI command for querying available acceleration flags
- New `bench` CLI command for running built-in benchmarks
- New `info` CLI command with expanded model introspection
- Benchmarking scripts covering fit, predict, scoring, and accel modes
- Tests: accel flag detection, accel selection, undef column handling,
data packing, parallel fit, sklearn comparison (including undef),
and CLI
- minor tweaks to `csv2plot` for a bit nicer rendering
- minor POD fixes
0.1.0 2026-06-23/03:15
- add csv2plot helper command for graphing
0.0.1 2026-06-21/21:45
- initial release
t/34-missing-values.t
t/35-online-accel.t
t/36-tagged-methods.t
t/37-majority-voting.t
t/38-online-basic.t
t/39-online-stream.t
t/41-mungers.t
t/42-prototype.t
t/91-streamd.t
t/92-streamc.t
t/01-accel-flags.t
t/90-cli-commands.t
t/02-accel-selection.t
t/03-fit-determinism.t
t/04-accel-tuning.t
t/05-prebuilt-env.t
examples/README.md
examples/basic-anomaly-detection.pl
examples/axis-vs-extended.pl
examples/contamination-threshold.pl
examples/save-and-load.pl
Makefile.PL view on Meta::CPAN
# generated Makefile gains a rule that compiles the Inline::C backend once
# during `make` and installs the shared object with the distribution, so
# users never pay the first-load compile and need neither a C compiler nor
# the Inline modules at run time.
#
# The IF_* environment variables (IF_OPT, IF_ARCH, IF_NATIVE, IF_NO_OPENMP)
# are captured *now* -- set them when running `perl Makefile.PL`, not
# `make` -- and recorded in the generated
# Algorithm::Classifier::IsolationForest::BuildFlags module. At run time
# those recorded values are the defaults: a process requesting the same
# flags loads the prebuilt object via XSLoader; one requesting different
# flags (or setting IF_RUNTIME_BUILD=1) falls back to the classic runtime
# Inline::C build under _Inline/. Validation mirrors the module's own,
# since these values reach a compiler command line.
# ---------------------------------------------------------------------------
my $if_opt = '-O3';
if ( defined $ENV{IF_OPT} ) {
if ( $ENV{IF_OPT} =~ /\A-O[0123sgz]\z/ ) {
$if_opt = $ENV{IF_OPT};
} else {
warn "Makefile.PL: ignoring invalid IF_OPT value '$ENV{IF_OPT}' "
. "(expected one of -O0 -O1 -O2 -O3 -Os -Og -Oz); using $if_opt\n";
Makefile.PL view on Meta::CPAN
# AUTOGENERATED by Makefile.PL -- do not edit and do not add to MANIFEST.
# Records per-install C build configuration; regenerate by re-running
# `perl Makefile.PL` (with IF_* environment variables as desired).
use strict;
use warnings;
=head1 NAME
Algorithm::Classifier::IsolationForest::BuildFlags - C build flags captured at configure time
=head1 DESCRIPTION
Autogenerated by Makefile.PL. Records the IF_* environment values that
were active when the distribution was configured, and whether a prebuilt
Inline::C object was scheduled for installation. Read once by
Algorithm::Classifier::IsolationForest at load time; see "NATIVE
ACCELERATION" in that module's documentation.
=head1 FUNCTIONS
=head2 flags
Returns a hashref with the keys C<opt>, C<arch>, C<no_openmp>, and
C<prebuilt>.
=cut
sub flags {
return {
opt => '$if_opt',
arch => '$if_arch',
no_openmp => $if_no_openmp,
prebuilt => $prebuilt,
};
}
1;
BUILDFLAGS
benchmarking/bench-axis-fit-accel.pl view on Meta::CPAN
#!/usr/bin/perl
# benchmarking/bench-axis-fit-accel.pl
#
# Benchmarks axis-mode (classic IF) fit() under each acceleration backend:
# pure_perl -- use_c => 0 (no _rebuild_c_trees)
# c_serial -- use_c => 1, use_openmp => 0 (includes _rebuild_c_trees)
# c_openmp -- use_c => 1, use_openmp => 1 (same + OpenMP flag set)
#
# Tree building itself is always pure Perl; the difference comes from the
# _rebuild_c_trees() packing step at the end of fit(). OpenMP only affects
# scoring, so c_serial and c_openmp should be nearly identical here --
# seeing that confirmed is the point.
#
# Sections:
# 1. n_trees -- packing cost grows with tree count
# 2. dataset size -- subsampling dominates; packing is fixed
# 3. feature count -- wide sweep (2, 5, 10, 20, 50)
benchmarking/bench-extended-fit-accel.pl view on Meta::CPAN
#!/usr/bin/perl
# benchmarking/bench-extended-fit-accel.pl
#
# Benchmarks extended-mode (EIF) fit() under each acceleration backend:
# pure_perl -- use_c => 0 (no _rebuild_c_trees)
# c_serial -- use_c => 1, use_openmp => 0 (includes _rebuild_c_trees)
# c_openmp -- use_c => 1, use_openmp => 1 (same + OpenMP flag set)
#
# Extended-mode tree building produces oblique hyperplane nodes that carry
# coefficient vectors, so _rebuild_c_trees has more data to pack than in
# axis mode. Comparing this script's numbers against the axis variant
# shows how much that extra packing costs at each tree/feature count.
#
# Sections:
# 1. n_trees -- packing cost grows with tree count
# 2. dataset size -- subsampling dominates; packing is fixed
# 3. feature count -- wide sweep (2, 5, 10, 20, 50)
benchmarking/bench-voting.pl view on Meta::CPAN
# point -- and forcing serial isolates that from OpenMP scheduling:
# early exit makes different points finish after different numbers
# of trees, so an OpenMP `parallel for` sees uneven per-point work
# and its load-imbalance jitter would otherwise swamp the effect
# being measured (wall_cmpthese times a single window, unlike
# wall_rate's windowed median -- see BenchAccel). The fewer-walks
# saving carries over to the OpenMP path; it is just far noisier to
# measure there.
#
# 2. DETECTIONS. On data with a known planted-outlier block we report,
# per decision threshold, how many points each mode flags, how many
# of the true outliers it catches (recall), how many inliers it
# flags (false alarms), and how often the two modes agree. The
# threshold means different things in each mode -- a forest-level
# score cutoff for mean, a per-tree cutoff for majority -- but the
# paper compares them at the same nominal value (0.6), so we do too.
#
# Run with:
# perl -Ilib benchmarking/bench-voting.pl
use strict;
use warnings;
use lib '../lib';
benchmarking/bench-voting.pl view on Meta::CPAN
sub gaussian {
my ( $mu, $sigma ) = @_;
return $mu + $sigma * sqrt( -2 * log( rand() || 1e-12 ) ) * cos( 2 * PI * rand() );
}
# Returns ($rows, $n_inliers): the first $n_inliers rows are the gaussian
# cluster, the remaining rows are the planted outliers (a 5% block pushed
# 5-8 sigma out). Keeping the split point lets the detection section
# score recall (true outliers caught) against false alarms (inliers
# flagged).
sub make_data {
my ( $n, $nf ) = @_;
my @rows = map {
[ map { gaussian( 0, 1 ) } 1 .. $nf ]
} 1 .. $n;
my $n_inliers = scalar @rows;
for ( 1 .. int( $n * 0.05 ) ) {
my $r = 5 + rand() * 3;
push @rows, [ map { $r * ( rand() > 0.5 ? 1 : -1 ) } 1 .. $nf ];
}
benchmarking/bench-voting.pl view on Meta::CPAN
} ## end for my $nf ( 2, 5, 10, 20, 50 )
# =======================================================================
# PART 2 -- DETECTIONS
# =======================================================================
print "\n", "=" x 70, "\n";
print " PART 2: outliers found (same trees, same data, both modes)\n";
print "=" x 70, "\n";
# Count how a label arrayref splits over a known inlier/outlier boundary.
# Returns (flagged_total, true_outliers_caught, inliers_flagged).
sub tally {
my ( $labels, $n_inliers ) = @_;
my ( $total, $caught, $false ) = ( 0, 0, 0 );
for my $i ( 0 .. $#$labels ) {
next unless $labels->[$i];
$total++;
if ( $i >= $n_inliers ) { $caught++ }
else { $false++ }
}
return ( $total, $caught, $false );
benchmarking/bench-voting.pl view on Meta::CPAN
my $det = build_pair(
n_trees => 200,
sample_size => 256,
mode => 'axis',
seed => 5,
_data => $det_data,
);
printf "\n%d samples: %d inliers + %d planted outliers, 8 features, n_trees=200\n", $n_total, $n_inliers, $n_out;
print "(recall = planted outliers caught; false = inliers flagged)\n";
printf "\n %-10s %-8s %9s %8s %8s %8s\n", 'threshold', 'voting', 'flagged', 'recall', 'false', 'agree%';
print " ", "-" x 62, "\n";
for my $thr ( 0.5, 0.6, 0.7 ) {
my $ml = $det->{mean}->predict( $det_data, $thr );
my $vl = $det->{majority}->predict( $det_data, $thr );
my ( $mt, $mc, $mf ) = tally( $ml, $n_inliers );
my ( $vt, $vc, $vf ) = tally( $vl, $n_inliers );
my $agree_pct = 100 * agreement( $ml, $vl ) / $n_total;
printf " %-10.2f %-8s %9s %7d/%d %8d %7.1f%%\n", $thr, 'mean', $mt, $mc, $n_out, $mf, $agree_pct;
printf " %-10s %-8s %9s %7d/%d %8d %7s\n", '', 'majority', $vt, $vc, $n_out, $vf, '';
} ## end for my $thr ( 0.5, 0.6, 0.7 )
# Contamination-learned thresholds: each mode learns its own cutoff to
# flag ~5% of the training set, then we compare what they actually catch.
print "\n--- contamination => 0.05 (each mode learns its own cutoff) ---\n";
my %learned;
for my $voting (qw(mean majority)) {
$learned{$voting} = Algorithm::Classifier::IsolationForest->new(
n_trees => 200,
sample_size => 256,
mode => 'axis',
seed => 5,
voting => $voting,
contamination => 0.05,
)->fit($det_data);
} ## end for my $voting (qw(mean majority))
printf "\n %-8s %10s %9s %8s %8s\n", 'voting', 'threshold', 'flagged', 'recall', 'false';
print " ", "-" x 52, "\n";
for my $voting (qw(mean majority)) {
my $m = $learned{$voting};
my $labels = $m->predict($det_data);
my ( $t, $c, $f ) = tally( $labels, $n_inliers );
printf " %-8s %10.4f %9d %7d/%d %8d\n", $voting, $m->decision_threshold, $t, $c, $n_out, $f;
}
print "\n";
examples/README.md view on Meta::CPAN
```sh
perl examples/basic-anomaly-detection.pl
```
Each script seeds the RNG so its output is reproducible.
| Script | Shows |
|------------------------------|------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
| `basic-anomaly-detection.pl` | The core workflow: `fit` → `score_samples` → `predict` on a Gaussian blob with known ring outliers, reported as a precision/recall summary and a ranked top-10. |
| `axis-vs-extended.pl` | `mode => 'axis'` vs `mode => 'extended'` on correlated (diagonal) data, illustrating how Extended Isolation Forest reduces the axis-aligned bias and better flags off-diagonal anomalies. |
| `contamination-threshold.pl` | Letting `contamination` auto-learn a cutoff at `fit` time, reading it back with `decision_threshold`, and how `predict` uses it by default vs a naive fixed 0.5. |
| `save-and-load.pl` | Persisting a trained model with `save`/`to_json` and restoring it with `load`/`from_json`, confirming a reloaded model scores bit-for-bit identically. |
| `server-metrics.pl` | An applied take: ranking server requests `[latency_ms, response_bytes]` by anomaly score, using `path_lengths` alongside `score_samples`, and writing the scored data to `request_scores.csv`. |
| `online-streaming.pl` | Online Isolation Forest (`::Online`) on a drifting stream: prequential `score_learn`, and how the sliding window makes the old regime anomalous and the new one normal after a drift. |
## Quick reference
```perl
use Algorithm::Classifier::IsolationForest;
examples/basic-anomaly-detection.pl view on Meta::CPAN
}
my $precision = $tp + $fp ? $tp / ( $tp + $fp ) : 0;
my $recall = $tp + $fn ? $tp / ( $tp + $fn ) : 0;
my $n_anom = grep { $_ } @truth;
my $n_normal = @truth - $n_anom;
printf "Trained on %d points (%d normal, %d anomalies)\n", scalar @data, $n_normal, $n_anom;
print "Threshold: 0.60\n\n";
printf " true anomalies caught (recall): %d/%d (%.0f%%)\n", $tp, $tp + $fn, 100 * $recall;
printf " flagged points that were real (prec): %.0f%%\n", 100 * $precision;
printf " false alarms: %d missed: %d\n\n", $fp, $fn;
# --- the 10 most anomalous points ---------------------------------------------
my @ranked = sort { $scores->[$b] <=> $scores->[$a] } 0 .. $#data;
print "Top 10 most anomalous points:\n";
printf " %-8s %-8s %-6s %-7s %s\n", 'x', 'y', 'score', 'flagged', 'truth';
for my $i ( @ranked[ 0 .. 9 ] ) {
printf " %-8.3f %-8.3f %-6.3f %-7s %s\n",
$data[$i][0], $data[$i][1], $scores->[$i],
( $labels->[$i] ? 'YES' : 'no' ),
( $truth[$i] ? 'anomaly' : 'normal' );
}
examples/contamination-threshold.pl view on Meta::CPAN
#!/usr/bin/env perl
# 03-contamination-threshold.pl
#
# Picking an anomaly score cutoff by hand is fiddly. If you can estimate what
# fraction of your data is anomalous, pass it as `contamination` and fit() will
# learn a threshold that flags about that fraction of the training set. predict()
# then uses that learned threshold by default, so you never have to guess a
# number.
#
# perl -Ilib examples/contamination-threshold.pl
use strict;
use warnings;
use Algorithm::Classifier::IsolationForest;
use List::Util qw(sum);
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:
# perl -Ilib examples/online-streaming.pl
examples/server-metrics.pl view on Meta::CPAN
contamination => 0.03, # we suspect ~3% of traffic is off
seed => 7,
);
$iforest->fit( \@requests );
# score_samples -> anomaly score in (0,1]; path_lengths -> mean isolation depth.
# They move in opposite directions: a *short* average path means the point was
# easy to isolate, which means a *high* score.
my $scores = $iforest->score_samples( \@requests );
my $depths = $iforest->path_lengths( \@requests );
my $flags = $iforest->predict( \@requests );
printf "Scored %d requests; learned threshold = %.3f\n\n", scalar @requests, $iforest->decision_threshold;
# --- rank and show the worst offenders ----------------------------------------
my @order = sort { $scores->[$b] <=> $scores->[$a] } 0 .. $#requests;
print "Most anomalous requests:\n";
printf " %-10s %-13s %-7s %-7s %s\n", 'latency_ms', 'resp_bytes', 'depth', 'score', 'flagged';
print ' ', '-' x 60, "\n";
for my $i ( @order[ 0 .. 9 ] ) {
printf " %-10.1f %-13.0f %-7.2f %-7.3f %s\n",
$requests[$i][0], $requests[$i][1],
$depths->[$i], $scores->[$i],
( $flags->[$i] ? 'YES' : '' );
}
my $n_flagged = grep { $_ } @$flags;
printf "\n%d of %d requests flagged as anomalous.\n", $n_flagged, scalar @requests;
# --- write the full scored dataset to CSV -------------------------------------
my $csv = 'request_scores.csv';
open my $out, '>', $csv or die "cannot write $csv: $!";
print {$out} "latency_ms,response_bytes,mean_path_length,anomaly_score,flagged\n";
for my $i ( 0 .. $#requests ) {
printf {$out} "%.2f,%.0f,%.4f,%.4f,%d\n",
$requests[$i][0], $requests[$i][1],
$depths->[$i], $scores->[$i], ( $flags->[$i] ? 1 : 0 );
}
close $out;
print "Wrote per-request scores to $csv (open it in a spreadsheet to plot).\n";
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# x: row-major doubles, n_pts rows of n_feats each.
# sums: out double array of length n_pts; score_all_xs writes once per i.
#
# OpenMP is enabled at module load when the toolchain accepts -fopenmp and
# libgomp is linkable; otherwise the same C code compiles to a serial loop
# (the #pragma is silently ignored without _OPENMP defined).
# ---------------------------------------------------------------------------
our $HAS_C = 0;
our $HAS_OPENMP = 0;
our $HAS_SIMD = 0;
our $OPT_LEVEL = ''; # the actual -O.../-march=... flags used to build, if any
our $C_SOURCE = ''; # 'prebuilt' (object installed at `make` time) or
# 'runtime' (compiled at first load into _Inline/);
# '' when $HAS_C is 0
{
my $C_CODE = <<'__INLINE_C__';
#include <math.h>
#include <string.h>
#include <stdint.h>
#ifdef _OPENMP
#include <omp.h>
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
* 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;
if (u1 == 0.0) u1 = 1e-12;
u2 = Drand01();
return sqrt(-2.0 * log(u1)) * cos(6.283185307179586 * u2);
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
AvFILLp(av) = 5;
return newRV_noinc((SV*)av);
}
/* Builds one node from the point set `idxs` (row indices into `x`,
* length `size`); recurses left-then-right, matching _build_tree's
* traversal order so nested splits draw random numbers in the same
* sequence the pure-Perl path would. Takes ownership of `idxs` --
* frees it before returning. */
static SV* _build_node_c(pTHX_ const double* x, int nf, int* idxs, int size,
int depth, int limit, int mode_flag,
int ext_active) {
double *lo, *hi;
int *varying, nv, f;
SV *result;
if (depth >= limit || size <= 1) {
SV* leaf = _mk_leaf(aTHX_ size);
free(idxs);
return leaf;
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
if (lo[f] < hi[f]) varying[nv++] = f;
}
if (nv == 0) {
free(lo); free(hi); free(varying);
SV* leaf = _mk_leaf(aTHX_ size);
free(idxs);
return leaf;
}
if (mode_flag == 0) {
/* Axis-parallel split: one varying feature, one threshold. */
int attr = varying[(int)(Drand01() * nv)];
double split = lo[attr] + Drand01() * (hi[attr] - lo[attr]);
int *lidx = (int*)malloc(size * sizeof(int));
int *ridx = (int*)malloc(size * sizeof(int));
int ln = 0, rn = 0, i;
SV *left, *right;
for (i = 0; i < size; i++) {
int row = idxs[i];
double v = x[(size_t)row * (size_t)nf + attr];
if (v < split) lidx[ln++] = row; else ridx[rn++] = row;
}
free(idxs); free(lo); free(hi); free(varying);
left = _build_node_c(aTHX_ x, nf, lidx, ln, depth + 1, limit,
mode_flag, ext_active);
right = _build_node_c(aTHX_ x, nf, ridx, rn, depth + 1, limit,
mode_flag, ext_active);
result = _mk_axis(aTHX_ attr, split, left, right);
} else {
/* Oblique split: a random hyperplane over `active` features. */
int active = ext_active + 1;
int *pool, *lidx, *ridx;
double *coef;
double b = 0.0;
int ln = 0, rn = 0, i, k;
SV *left, *right;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
int row = idxs[i];
double dot = 0.0;
for (k = 0; k < active; k++) {
dot += coef[k] * x[(size_t)row * (size_t)nf + pool[k]];
}
if (dot <= b) lidx[ln++] = row; else ridx[rn++] = row;
}
free(idxs); free(lo); free(hi); free(varying);
left = _build_node_c(aTHX_ x, nf, lidx, ln, depth + 1, limit,
mode_flag, ext_active);
right = _build_node_c(aTHX_ x, nf, ridx, rn, depth + 1, limit,
mode_flag, ext_active);
result = _mk_oblique(aTHX_ pool, coef, active, b, left, right);
free(pool); free(coef);
}
return result;
}
void build_forest_xs(SV* x_sv, int n_pts, int n_feats, int n_trees,
int psi, int limit, int mode_flag, int ext_level,
SV* out_rv) {
dTHX;
STRLEN tl;
const double* x;
AV* out;
int* all;
int t, i;
if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
croak("build_forest_xs: out must be an arrayref");
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
for (i = 0; i < n_pts; i++) all[i] = i;
for (i = 0; i < psi; i++) {
int j = i + (int)(Drand01() * (n_pts - i));
int tmp = all[i]; all[i] = all[j]; all[j] = tmp;
}
sample = (int*)malloc(psi * sizeof(int));
memcpy(sample, all, psi * sizeof(int));
av_store(out, t,
_build_node_c(aTHX_ x, n_feats, sample, psi, 0, limit,
mode_flag, ext_level));
}
free(all);
}
/* ---------------------------------------------------------------------
* build_forest_openmp_xs -- OpenMP-parallel fit() tree builder.
*
* build_forest_xs (above) is bit-identical to the pure-Perl path
* because every random draw goes through Drand01(), the same
* generator Perl's rand()/srand() use -- but that generator is a
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
u2 = sm64_drand(s);
return sqrt(-2.0 * log(u1)) * cos(6.283185307179586 * u2);
}
/* Thread-safe twin of _build_node_c: same split algorithm, but reads
* randomness from a thread-private splitmix64 stream instead of
* Drand01(), and writes into a TreeBuf instead of allocating Perl AVs
* -- so it touches no interpreter-global state and is safe to call
* concurrently from an OpenMP parallel region, one tree per thread. */
static int _build_node_packed(const double* x, int nf, int* idxs, int size,
int depth, int limit, int mode_flag,
int ext_active, TreeBuf *buf, uint64_t *rng) {
double *lo, *hi;
int *varying, nv, f, my_idx;
if (depth >= limit || size <= 1) {
my_idx = tb_push_node(buf, 0.0, (double)size, 0.0, 0.0, 0.0, 0.0);
free(idxs);
return my_idx;
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
if (lo[f] < hi[f]) varying[nv++] = f;
}
if (nv == 0) {
free(lo); free(hi); free(varying);
my_idx = tb_push_node(buf, 0.0, (double)size, 0.0, 0.0, 0.0, 0.0);
free(idxs);
return my_idx;
}
if (mode_flag == 0) {
int attr = varying[(int)(sm64_drand(rng) * nv)];
double split = lo[attr] + sm64_drand(rng) * (hi[attr] - lo[attr]);
int *lidx = (int*)malloc(size * sizeof(int));
int *ridx = (int*)malloc(size * sizeof(int));
int ln = 0, rn = 0, i, li, ri;
for (i = 0; i < size; i++) {
int row = idxs[i];
double v = x[(size_t)row * (size_t)nf + attr];
if (v < split) lidx[ln++] = row; else ridx[rn++] = row;
}
free(idxs); free(lo); free(hi); free(varying);
li = _build_node_packed(x, nf, lidx, ln, depth + 1, limit,
mode_flag, ext_active, buf, rng);
ri = _build_node_packed(x, nf, ridx, rn, depth + 1, limit,
mode_flag, ext_active, buf, rng);
my_idx = tb_push_node(buf, 1.0, (double)attr, split,
(double)li, (double)ri, 0.0);
} else {
int active = ext_active + 1;
int *pool, *lidx, *ridx;
double *coef;
double b = 0.0;
int ln = 0, rn = 0, i, k, li, ri, coff;
if (active > nv) active = nv;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
int row = idxs[i];
double dot = 0.0;
for (k = 0; k < active; k++) {
dot += coef[k] * x[(size_t)row * (size_t)nf + pool[k]];
}
if (dot <= b) lidx[ln++] = row; else ridx[rn++] = row;
}
free(idxs); free(lo); free(hi); free(varying);
li = _build_node_packed(x, nf, lidx, ln, depth + 1, limit,
mode_flag, ext_active, buf, rng);
ri = _build_node_packed(x, nf, ridx, rn, depth + 1, limit,
mode_flag, ext_active, buf, rng);
coff = tb_push_coef(buf, pool, coef, active);
my_idx = tb_push_node(buf, 2.0, (double)coff, (double)active,
(double)li, (double)ri, b);
free(pool); free(coef);
}
return my_idx;
}
void build_forest_openmp_xs(SV* x_sv, int n_pts, int n_feats, int n_trees,
int psi, int limit, int mode_flag,
int ext_level, SV* nodes_rv, SV* idx_rv,
SV* val_rv, int use_openmp) {
dTHX;
STRLEN tl;
const double* x;
AV *nodes_av, *idx_av, *val_av;
TreeBuf *bufs;
uint64_t base_seed;
int t;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
for (i = 0; i < n_pts; i++) all[i] = i;
for (i = 0; i < psi; i++) {
int j = i + (int)(sm64_drand(&rng) * (n_pts - i));
int tmp = all[i]; all[i] = all[j]; all[j] = tmp;
}
sample = (int*)malloc((size_t)psi * sizeof(int));
memcpy(sample, all, (size_t)psi * sizeof(int));
free(all);
_build_node_packed(x, n_feats, sample, psi, 0, limit, mode_flag,
ext_level, &bufs[t], &rng);
}
for (t = 0; t < n_trees; t++) {
/* newSVpvn(NULL, 0) makes an undef SV, not an empty-string one --
* axis-mode trees never call tb_push_coef, so idx/val stay NULL.
* Pass "" instead so the Perl side's unpack('...', $sv) always
* gets a defined (if empty) string, never undef. */
av_store(nodes_av, t, newSVpvn((char*)bufs[t].nodes,
bufs[t].n_nodes * 6 * sizeof(double)));
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# Algorithm::Classifier::IsolationForest::BuildFlags, capturing the
# IF_* values active at configure time plus whether a prebuilt object
# was scheduled for install (see "Compile at install time" in the POD
# below). From a plain source checkout the generated file is absent,
# the hard defaults here apply, and no prebuilt object is looked for.
my ( $def_opt, $def_arch, $def_no_omp, $prebuilt ) = ( '-O3', '', 0, 0 );
{
local $@;
my $rec = eval {
require Algorithm::Classifier::IsolationForest::BuildFlags;
Algorithm::Classifier::IsolationForest::BuildFlags::flags();
};
if ( ref $rec eq 'HASH' ) {
$def_opt = $rec->{opt} if defined $rec->{opt};
$def_arch = $rec->{arch} if defined $rec->{arch};
$def_no_omp = $rec->{no_openmp} ? 1 : 0;
$prebuilt = $rec->{prebuilt} ? 1 : 0;
}
}
# -O3 is the usual default: it's safe to enable unconditionally and
# matters here -- the extended-mode oblique dot product is wrapped in
# `#pragma omp simd`, but without aggressive optimization the compiler
# may still emit scalar code. Use OPTIMIZE (not CCFLAGS) -- CCFLAGS is
# prepended to the cc line and would be shadowed by Perl's own `-O2 -g`
# that ExtUtils::MakeMaker appends afterward (last `-O` wins in gcc).
# IF_OPT overrides the level itself (e.g. IF_OPT=-O2 to work around a
# miscompile, or to shorten build time while developing); it's
# validated against a fixed set of GCC/Clang -O flags rather than
# interpolated as-is, since this string eventually reaches a shell
# command line via ExtUtils::MakeMaker.
my $opt = $def_opt;
if ( defined $ENV{IF_OPT} ) {
if ( $ENV{IF_OPT} =~ /\A-O[0123sgz]\z/ ) {
$opt = $ENV{IF_OPT};
} else {
warn "Algorithm::Classifier::IsolationForest: ignoring invalid "
. "IF_OPT value '$ENV{IF_OPT}' (expected one of -O0 -O1 -O2 "
. "-O3 -Os -Og -Oz); using $opt\n";
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# is skipped, so the object has no libgomp linkage and never starts an
# OpenMP runtime in the process. Distinct from OMP_NUM_THREADS=1,
# which runs the parallel code on a single thread but still loads
# libgomp. An explicit IF_NO_OPENMP=0 re-enables OpenMP over a
# no-openmp configure-time default.
my $no_omp
= defined $ENV{IF_NO_OPENMP}
? ( $ENV{IF_NO_OPENMP} ? 1 : 0 )
: $def_no_omp;
# The prebuilt object is only trusted when the effective flags match
# what it was compiled with; any difference -- or an explicit
# IF_RUNTIME_BUILD=1 -- falls through to the classic runtime Inline::C
# build below, which honours the requested flags via the MD5-keyed
# _Inline/ cache exactly as before prebuilt support existed.
# IF_INSTALL_BUILD is the `make` rule driving the install-time compile
# (see Makefile.PL); it must never short-circuit into loading an
# older object.
my $use_prebuilt
= $prebuilt
&& !$ENV{IF_RUNTIME_BUILD}
&& !$ENV{IF_INSTALL_BUILD}
&& $opt eq $def_opt
&& $arch eq $def_arch
&& $no_omp == $def_no_omp;
# Inline::C hashes the C source to decide whether to rebuild but
# does NOT include CCFLAGS / OPTIMIZE in that hash. Without the
# tag below, toggling IF_NATIVE/IF_ARCH/IF_OPT (or editing the
# optimisation flags here) would silently reuse a cached binary
# built with stale flags. Embedding the active flags as a leading
# comment forces the hash to differ when they change. The OpenMP
# and serial builds get distinct tags so they cache to separate
# artefacts.
my $omp_tag = "/* if_build: openmp $opt_level */\n";
my $serial_tag = "/* if_build: serial $opt_level */\n";
if ( $ENV{IF_INSTALL_BUILD} ) {
# `make` is driving: the rule Makefile.PL appended runs this load
# with IF_INSTALL_BUILD=1 and @ARGV = (version, INST_ARCHLIB),
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# Classic, axis-parallel Isolation Forest
my $iforest = Algorithm::Classifier::IsolationForest->new(
n_trees => 100,
sample_size => 256,
seed => 42,
);
$iforest->fit(\@data);
my $scores = $iforest->score_samples(\@data); # arrayref, each in (0,1]
my $flags = $iforest->predict(\@data, 0.6); # arrayref of 0/1
# Save and reload
$iforest->save('model.json');
my $reloaded = Algorithm::Classifier::IsolationForest->load('model.json');
# Extended Isolation Forest (oblique hyperplane splits)
my $eif = Algorithm::Classifier::IsolationForest->new(
mode => 'extended',
seed => 42,
);
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
sample_size => 256,
seed => 42,
parallel_fit => 4, # 4 forked workers
);
$iforest->fit(\@data);
# Pre-pack a dataset to skip the per-call input-walk cost when the
# same data gets scored many times (interactive tuning, dashboards).
my $packed = $iforest->pack_data(\@data);
my $scores = $iforest->score_samples($packed);
my $flags = $iforest->predict($packed, 0.6);
# Get scores and labels as two flat arrayrefs in one call -- cheaper
# than score_predict_samples when you don't need the paired shape.
my ($s, $l) = $iforest->score_predict_split(\@data, 0.6);
=head1 DESCRIPTION
Isolation Forest (Liu, Fei Tony & Ting, Kai & Zhou, Zhi-Hua, 2008) detects anomalies by random
partitioning rather than by modelling normal points. Each tree repeatedly
splits the data. Points that get isolated after only a few splits are likely
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$Algorithm::Classifier::IsolationForest::HAS_OPENMP # 0/1
$Algorithm::Classifier::IsolationForest::HAS_SIMD # 0/1 (OpenMP 4.0+)
$Algorithm::Classifier::IsolationForest::OPT_LEVEL # e.g. "-O3 -march=native", '' if HAS_C is 0
$Algorithm::Classifier::IsolationForest::C_SOURCE # 'prebuilt' / 'runtime', '' if HAS_C is 0
Neither dependency is required. Without C<Inline::C> the module falls
back to a pure-Perl implementation that produces identical results, just
slower; without OpenMP the C backend runs single-threaded.
The bundled C<iforest accel> subcommand performs a tiny fit + score and
prints which backend is active (including the build flags below), which
is the recommended way to verify the build picked up the optional
dependencies on a given machine.
=head2 Compile at install time (the prebuilt object)
When C<Inline::C> is usable while the distribution itself is being
built, C<perl Makefile.PL> arranges for the C backend to be compiled
once during C<make> and installed alongside the module like any XS
object. At run time that object is loaded directly through
L<XSLoader>: no C compiler, no C<Inline> modules, and no C<_Inline/>
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
On x86-64 hardware from roughly the last decade,
C<IF_ARCH=x86-64-v3 perl Makefile.PL> is a reasonable configure line:
it bakes AVX2 + FMA (without AVX-512) into the prebuilt object, which
can speed up extended-mode scoring (how much is hardware-dependent --
benchmark with C<iforest bench> before assuming) while avoiding the
C<-march=native> caveats described under L</Tuning the C build>.
Bit-for-bit result parity with the pure-Perl backend is preserved
either way (see C<IF_ARCH> below).
The C<IF_*> build flags described below are captured when
C<perl Makefile.PL> runs -- set them in the environment of I<that>
command, not of C<make> -- and recorded in the generated
C<Algorithm::Classifier::IsolationForest::BuildFlags> module, which
thereby also fixes what the prebuilt object was compiled with. At run
time the recorded values serve as the defaults, so a process started
with no C<IF_*> variables set uses the prebuilt object as-is.
Setting C<IF_*> variables at run time keeps working exactly as in
releases without prebuilt support: if the requested flags differ from
the recorded ones, the prebuilt object (compiled with the wrong flags
for the request) is skipped and the module compiles at first load into
C<_Inline/> -- which does need C<Inline::C> and a compiler on that
machine. Two related knobs exist:
=over 4
=item * C<IF_RUNTIME_BUILD=1> -- ignore the prebuilt object
unconditionally and compile at first load even though the requested
flags match the recorded ones. Useful when the installed object is
suspect (built on a different CPU than it now runs on, linked against a
libgomp that has since changed) or to A/B a fresh local build against
the shipped one.
=item * C<IF_INSTALL_BUILD=1> -- internal; set by the generated
Makefile rule that performs the install-time compile. Not meant for
manual use.
=back
If the prebuilt object cannot be loaded for any reason (deleted, built
against a different perl, version mismatch after an upgrade), the
module quietly falls through the same chain as always: runtime
Inline::C build first, pure Perl last.
=head2 Tuning the C build
These environment variables are read once, the first time the module is
loaded, so they must be set before that -- e.g. in the shell before
running a script, not via C<%ENV> inside the script itself. They are
also read by C<perl Makefile.PL> to pick the flags baked into the
prebuilt object (see above); at run time they override the recorded
configure-time values, at the price of a runtime compile.
=over 4
=item * C<IF_NO_C=1> -- skip attempting to build the C backend entirely.
Equivalent to constructing every instance with C<use_c =E<gt> 0>, but
without needing to touch every call site; useful for a clean pure-Perl
timing baseline, or to avoid the compile attempt's overhead/noise on a
host known to lack a C compiler (the attempt already fails gracefully
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
axis :: classic axis-parallel splits (IF)
extended :: oblique hyperplane splits (EIF)
default :: axis
- extension_level :: extended mode only... how many features take partin each
split. 0 behaves like a single-feature (axis) cut; the
maximum (n_features - 1) uses every varying feature. undef
=> maximum. Clamped to [0, n_features - 1] at fit time.
- contamination :: expected fraction of anomalies, in (0, 0.5]. When given,
fit() learns a score threshold that flags this fraction of
the training set, and predict() uses it by default. undef
=> no learned threshold (predict() falls back to 0.5).
default :: undef
- missing :: how fit() treats undef (missing) feature cells. Scoring always
tolerates undef regardless of this setting; it governs fit().
die :: croak from fit() if the training data contains any
undef cell. Scoring still maps undef to 0 (the
long-standing behaviour), so a model fitted on clean
data can still score rows with missing features.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
extended) and an existing model may switch it after the fact with
set_voting() (which relearns a contamination threshold for the
new mode).
mean :: classic Isolation Forest: a sample's path lengths
across all trees are averaged and normalised into
one anomaly score; predict() thresholds that score.
majority :: Majority Voting Isolation Forest (MVIForest;
Chabchoub, Togbe, Boly & Chiky 2022 -- see
REFERENCES). Each tree scores the sample on its own
(s_i = 2**(-h_i / c(psi))) and votes it anomalous
when s_i >= the decision threshold; predict() flags
the sample when more than half of the trees
(int(n_trees/2) + 1) vote anomalous, and stops
walking trees per sample as soon as the outcome is
decided. The threshold argument/default of the
predict methods is therefore the PER-TREE cutoff
here, not a forest-level score cutoff.
score_samples() returns the fraction of trees
voting anomalous -- still in [0, 1], but discrete
in steps of 1/n_trees. contamination composes: fit()
learns the per-tree cutoff that flags the requested
fraction of the training set.
default :: mean
- parallel_fit :: positive integer N => build the trees across N forked
worker processes during fit(). Each worker gets a derived seed
(parent seed + worker_id * 1009) so the parallel fit is
reproducible across runs at fixed worker count -- but the trees
produced are NOT bit-identical to a serial fit with the same
seed, because the RNG draws happen in a different order.
Inference is unaffected. Falls back silently to serial on
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
identical in both modes -- only the way per-tree results are combined changes
-- so this never rebuilds a single tree.
$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
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$self->{trees} = \@trees;
}
# On a re-fit, packed scoring buffers from the previous fit are still
# sitting on the object; score_samples() below would pick them up and
# learn the contamination threshold against the OLD forest. Drop them
# so the training-set scoring runs pure-Perl against the trees just
# built; _rebuild_c_trees repacks from the new trees at the end.
delete @$self{qw(_c_nodes _c_coef_idx _c_coef_val)};
# If a contamination rate was requested, learn the score cutoff that flags
# that fraction of the training set. The threshold lands midway inside a
# real gap between flagged and unflagged training scores (ties at the
# k-boundary shift the cut to the nearest gap -- see
# _threshold_from_ranked), so it sits strictly between attainable values:
# unambiguous and robust to the tiny float rounding introduced by JSON
# serialisation.
#
# Under voting => 'majority' the value predict() thresholds against is
# the PER-TREE score, so the quantity to rank is each training point's
# majority pivot -- the per-tree cutoff at which that point loses its
# majority (see _majority_pivot_scores). A point is flagged iff its
# pivot >= threshold, exactly the relation the mean-mode score has, so
# the midpoint selection below serves both modes unchanged.
$self->_learn_contamination_threshold($train)
if defined $self->{contamination};
$self->_rebuild_c_trees() if $self->{_use_c};
return $self;
} ## end sub fit
=head2 fit_tagged(\@rows)
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
high feature counts this is a meaningful win when the same dataset is
scored repeatedly (e.g. interactive threshold tuning, dashboards,
plotting that updates as parameters change).
Requires the Inline::C backend; croaks if C<use_c> is false.
my $packed = $forest->pack_data(\@data);
# Now any of these accept either an arrayref or the packed wrapper:
my $scores = $forest->score_samples($packed);
my $flags = $forest->predict($packed, 0.6);
my ($s, $l) = $forest->score_predict_split($packed);
The wrapper has C<n_pts> and C<n_feats> accessors for introspection.
The feature count is matched against the model on every call; passing a
packed dataset built for a different feature count is a fatal error.
=cut
=head2 path_lengths(\@data)
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $inv = log(2) / ( $c * $t );
return [ map { exp( -$_ * $inv ) } @sums ];
}
return [ (0.5) x @sums ];
} ## end sub score_samples
=head2 score_sample_tagged(\%row)
Scores a single sample supplied as a hashref of named feature values.
The model must have stored feature names (set via C<feature_names> in
C<new()> or the C<-t> CLI flag at fit time).
Returns a scalar anomaly score in (0, 1].
my $score = $forest->score_sample_tagged({ cpu => 0.9, mem => 0.4 });
Croaks if the model has no stored feature names, if the hashref contains a
key that is not a known feature name, or if a feature name is absent from the
hashref.
=cut
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
return -$c * log($theta) / log(2);
}
# Smallest number of per-tree anomaly votes that constitutes a majority:
# int(t/2) + 1, i.e. strictly more than half the trees for both odd and
# even tree counts (the paper's "t/2 + 1").
sub _min_votes { return int( $_[0] / 2 ) + 1 }
#-------------------------------------------------------------------------------
# Contamination threshold selection: given the training scores ranked
# descending and the target flag count k, return a cutoff sitting midway
# inside the gap between the last flagged and the first unflagged score.
#
# Tied scores at the k-boundary make an exact count of k unattainable (the
# tie block can only go one way or the other) AND make the naive midpoint
# degenerate -- it equals the tied value, leaving predict()'s >= comparison
# balanced on exact float equality. Mean-mode scores are continuous enough
# that this practically never happens, but majority-mode pivots are
# structurally quantized (path lengths at the depth cap take few distinct
# values -- see _majority_pivot_scores), so ties there are the norm, and
# the score <-> depth-cut conversion adds an exp/log round trip that needs
# real slack around the cutoff rather than exact-equality behaviour. The
# whole tie block therefore goes to whichever side lands the flag count
# closest to k, preferring the flagging side on a dead heat.
#-------------------------------------------------------------------------------
sub _threshold_from_ranked {
my ( $desc, $k ) = @_;
my $n = scalar @$desc;
return $desc->[ $n - 1 ] - 1e-9 if $k >= $n; # flag everything
my $v = $desc->[ $k - 1 ];
return ( $v + $desc->[$k] ) / 2.0 if $desc->[$k] < $v; # clean gap at k
# Tie block straddling the k-boundary: locate its edges.
my $i = $k - 1;
$i-- while $i > 0 && $desc->[ $i - 1 ] == $v; # first index holding $v
my $j = $k;
$j++ while $j < $n && $desc->[$j] == $v; # first index below $v
if ( $i > 0 && ( $k - $i ) < ( $j - $k ) ) {
# Excluding the block lands closer to k: flag the $i points above it.
return ( $desc->[ $i - 1 ] + $v ) / 2.0;
}
return $j < $n
? ( $v + $desc->[$j] ) / 2.0 # include the block: flag $j
: $desc->[ $n - 1 ] - 1e-9; # block runs to the end
} ## end sub _threshold_from_ranked
# Pure-Perl vote counter: votes[i] = how many trees give point i a path
# length at or under the depth cut. Tree-outer / sample-inner for cache
# locality, mirroring the mean-mode fallback loops. $data must already
# be through _prepare_perl_input.
sub _vote_counts_perl {
my ( $self, $data, $cut ) = @_;
my $trees = $self->{trees};
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
for my $i ( 0 .. $#$data ) {
$votes[$i]++ if _path_length( $data->[$i], $tree, 0, $nan ) <= $cut;
}
}
return \@votes;
} ## end sub _vote_counts_perl
#-------------------------------------------------------------------------------
# Contamination support for majority voting: each training point's majority
# pivot -- the per-tree score threshold at which the point loses its
# majority. A point is flagged at cutoff theta iff at least min_votes of
# its per-tree path lengths h satisfy h <= -c*log2(theta), which holds iff
# its min_votes-th SMALLEST path length h_(maj) does, i.e. iff
# 2**(-h_(maj)/c) >= theta. So the pivot m = 2**(-h_(maj)/c) relates to
# the majority-mode threshold exactly as the mean-mode score relates to
# its threshold, and fit()'s midpoint selection works on either unchanged.
#
# Pure Perl by necessity: the per-tree path lengths never cross the C
# boundary individually (score_all_xs/vote_all_xs only return per-point
# aggregates), and fit() has already dropped any stale packed buffers when
# this runs -- the same situation as mean mode's training-set scoring pass.
#-------------------------------------------------------------------------------
# Learn the contamination cutoff for the CURRENT voting mode from a training
# set. Ranks the per-point quantity the active aggregation thresholds against
# -- the mean-mode anomaly score, or the majority pivot under
# voting => 'majority' -- and lands the cutoff midway inside a real gap between
# flagged and unflagged values (ties at the k-boundary shift it to the nearest
# gap; see _threshold_from_ranked), so it sits strictly between attainable
# values: unambiguous and robust to the float rounding JSON introduces. A
# point is flagged iff its statistic >= threshold in either mode, so the
# midpoint selection serves both unchanged. Shared by fit() (which passes the
# prepared training set after dropping any stale packed buffers) and
# set_voting() (which passes the caller-supplied training set against the
# live, fully packed forest); $data may hold raw undef cells either way, since
# the scorers below densify from missing_fill.
sub _learn_contamination_threshold {
my ( $self, $data ) = @_;
my $scores
= $self->{voting} eq 'majority'
? $self->_majority_pivot_scores($data)
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# plus c(leaf size) when the leaf still holds several points.
#
# 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] ];
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# existing `use_c` knob instead of a new one.
#-------------------------------------------------------------------------------
sub _build_forest_c {
my ( $self, $data, $psi, $limit, $n_trees ) = @_;
my $n = scalar @$data;
my $nf = $self->{n_features};
my $x_packed = "\0" x ( $n * $nf * 8 );
my ( $mode, $fill ) = $self->_pack_args;
pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
my $ext_level = $self->{extension_level_used} // 0;
my $trees = [];
build_forest_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit, $mode_flag, $ext_level, $trees );
return $trees;
} ## end sub _build_forest_c
#-------------------------------------------------------------------------------
# OpenMP-parallel fit(): builds $n_trees trees across OpenMP threads (one
# tree per thread) via build_forest_openmp_xs. Unlike _build_forest_c,
# random draws come from a thread-private PRNG seeded per tree index
# rather than Drand01() -- Perl's RNG state can't be shared safely
# across OpenMP threads -- so the resulting trees are NOT bit-identical
# to the use_c (serial) or pure-Perl paths for the same seed, though a
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# need to know this path exists.
#-------------------------------------------------------------------------------
sub _build_forest_openmp {
my ( $self, $data, $psi, $limit, $n_trees ) = @_;
my $n = scalar @$data;
my $nf = $self->{n_features};
my $x_packed = "\0" x ( $n * $nf * 8 );
my ( $mode, $fill ) = $self->_pack_args;
pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
my $ext_level = $self->{extension_level_used} // 0;
my ( @nodes, @idx, @val );
build_forest_openmp_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit,
$mode_flag, $ext_level, \@nodes, \@idx, \@val, 1 );
return _unpack_forest( \@nodes, \@idx, \@val );
} ## 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
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $nf = $self->{n_features};
my $how = $self->{impute_with};
# C fast path: walks the raw data directly and finds the median via
# quickselect (O(n) average) instead of the Perl fallback's full sort
# (O(n log n)). Produces the same fill values either way -- see
# impute_fill_xs's file-top comment -- so use_c only changes speed
# here, matching the rest of the module.
if ( $self->{_use_c} ) {
my $n = scalar @$data;
my $how_flag = $how eq 'median' ? 1 : 0;
my $fill = [];
impute_fill_xs( $data, $n, $nf, $how_flag, $fill );
return $fill;
}
my @fill;
for my $f ( 0 .. $nf - 1 ) {
my @vals = grep { defined } map { $_->[$f] } @$data;
croak "impute: feature column $f has no present values"
unless @vals;
if ( $how eq 'median' ) {
my @s = sort { $a <=> $b } @vals;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
unless ref $fill eq 'ARRAY' && @$fill == $self->{n_features};
$self->{_fill_packed} //= pack( 'd*', @$fill );
return ( 1, $self->{_fill_packed} );
}
return ( 0, '' ); # die, zero
} ## end sub _pack_args
# Pure-Perl fallback input prep: arrayref-ify, then fill for impute so the
# tree walk sees dense rows. zero/die rely on _path_length's "// 0"; nan
# keeps undef in place for _path_length to route. Returns the rows; the
# caller passes the nan flag to _path_length separately.
sub _prepare_perl_input {
my ( $self, $data ) = @_;
my $rows = $self->_to_arrayref($data);
if ( $self->{missing} eq 'impute' ) {
croak "impute model is missing its fill vector"
unless ref $self->{missing_fill} eq 'ARRAY';
$rows = _densify( $rows, $self->{missing_fill} );
}
return $rows;
} ## end sub _prepare_perl_input
lib/Algorithm/Classifier/IsolationForest/App/Command/accel.pm view on Meta::CPAN
* OpenMP -- parallel tree-walk across CPU cores (requires libgomp)
* SIMD -- vectorised oblique dot product in extended mode
(gated on OpenMP 4.0+; relies on `#pragma omp simd`)
The detection happens automatically the first time the module is loaded.
When the distribution was installed with Inline::C available, a prebuilt
object compiled at `make` time is loaded directly; otherwise the backend
is compiled on first load and cached under _Inline/. If no backend is
active the module falls back to a pure-Perl implementation.
Build flags are tunable via environment variables set before first load
(and, to pick what gets baked into the prebuilt object, before
`perl Makefile.PL`):
* IF_ARCH=<value> -- -march=<value> (e.g. x86-64-v3, skylake, znver3)
* IF_NATIVE=1 -- shorthand for IF_ARCH=native; ignored if IF_ARCH is set
* IF_OPT=<-Olevel> -- override the default -O3
* IF_NO_OPENMP=1 -- serial C backend: no libgomp linkage at all
* IF_RUNTIME_BUILD=1 -- ignore the prebuilt object, compile at first load
* IF_NO_C=1 -- skip the C backend entirely
lib/Algorithm/Classifier/IsolationForest/App/Command/accel.pm view on Meta::CPAN
my $c_source = $Algorithm::Classifier::IsolationForest::C_SOURCE;
# Whether a prebuilt object was installed with the dist at all --
# independent of whether this process ended up using it.
my $prebuilt_installed = 0;
{
local $@;
my $bf = eval {
require Algorithm::Classifier::IsolationForest::BuildFlags;
Algorithm::Classifier::IsolationForest::BuildFlags::flags();
};
$prebuilt_installed = 1 if ref $bf eq 'HASH' && $bf->{prebuilt};
}
my $source_desc
= $c_source eq 'prebuilt' ? 'prebuilt at install time'
: $c_source eq 'runtime' ? 'compiled at run time (cached under _Inline/)'
: 'none (pure-Perl fallback)';
print "Algorithm::Classifier::IsolationForest acceleration status\n";
lib/Algorithm/Classifier/IsolationForest/App/Command/accel.pm view on Meta::CPAN
push @why, grep { defined $ENV{$_} } qw(IF_OPT IF_ARCH IF_NATIVE IF_NO_OPENMP);
print " (a prebuilt object is installed but was not used",
(
@why
? '; runtime overrides active: ' . join( ', ', @why )
: '; it failed to load'
),
")\n";
} ## end if ( $c_source ne 'prebuilt' && $prebuilt_installed)
if ($has_c) {
printf " Build flags: %s\n", $Algorithm::Classifier::IsolationForest::OPT_LEVEL;
}
print "\n";
# Build a one-line backend summary that lists every active feature
# and where the C object came from.
my @features;
push @features, 'OpenMP' if $has_openmp;
push @features, 'SIMD' if $has_simd;
my $suffix
lib/Algorithm/Classifier/IsolationForest/App/Command/csv2plot.pm view on Meta::CPAN
Plot types are as below.
auto: If there are two columns, 2heat. If there are 4 or more columns, 3range.
2heat: Use column 1 and 2 to generate a splatter plot over a heat map.
3range: Use columns 1 and 2 for x/y, and the second-to-last column for the
score gradient. Suitable for predict -d output (any number of features).
3binary: Use columns 1 and 2 for x/y, and the last column for normal/abnormal.
Suitable for predict -d output or gblob output.
3range and 3binary require data outputted from predict with the -d flag.
For N-dimensional data, columns 1 and 2 are always used for the x/y axes.
';
} ## end sub description
sub validate {
my ( $self, $opt, $args ) = @_;
if ( !defined( $opt->{'i'} ) ) {
$self->usage_error('-i has not been specified for a file to process');
} elsif ( !-f $opt->{'i'} ) {
lib/Algorithm/Classifier/IsolationForest/App/Command/fit.pm view on Meta::CPAN
[ 'extended', 'Use EIF instead of IF.' ],
[ 'n=i', 'Number of isolation trees in the ensemble' ],
[ 'm=i', 'Sub-sample size used to build each tree... max samples' ],
[ 'd=i', 'per-tree height limit... if not defined is set to ceil(log2(psi))' ],
[
'e=f',
'How many features take partin each split. 0 behaves like a single-feature (axis) cut; the maximum (n_features - 1) uses every varying feature. undef => maximum. Clamped to [0, n_features - 1] at fit time. May only be used with -e.'
],
[
'c=f',
'Contamination. Expected fraction of anomalies, in (0, 0.5]. When given, fit() learns a score threshold that flags this fraction of the training set, and predict() uses it by default. undef => no learned threshold (predict() falls back to 0.5).'
],
[
't=s@',
'Feature name tag. Pass once per feature (e.g. -t cpu -t mem -t disk); the count must match the number of CSV columns or the command will die.'
],
[
'voting=s',
"Scoring-time aggregation: 'mean' (classic averaged score, the default) or 'majority' (MVIForest: each tree votes against the decision threshold and the label is the majority vote).",
],
[
lib/Algorithm/Classifier/IsolationForest/App/Command/streamc.pm view on Meta::CPAN
transactional). All row validation is the daemon\'s: only it knows
whether the model munges.
Command mode sends exactly one of --ping, --stats, --save, or
--relearn-threshold and renders the reply as text (--json for the raw
reply). The exit code is 0 on ok and non-zero on error, connect
failure, or timeout, so `iforest streamc --set web --ping` works
directly in health checks.
--set/--socket resolve the socket path exactly as streamd does, so the
same flags reach the same daemon.
';
} ## end sub description
sub validate {
my ( $self, $opt, $args ) = @_;
if ( defined( $opt->{'set'} ) && $opt->{'set'} !~ /\A[A-Za-z0-9+\-@_]+\z/ ) {
$self->usage_error( '--set, "'
. $opt->{'set'}
. '", must match /\A[A-Za-z0-9+\-@_]+\z/ (letters, digits, and + - @ _ only)' );
lib/Algorithm/Classifier/IsolationForest/App/Command/streamc.pm view on Meta::CPAN
# Lazily required for the same reason streamd does it: App::Cmd loads
# every command module up front, and the rest of the CLI should work
# on a box without JSON::MaybeXS.
eval { require JSON::MaybeXS; 1 }
or die( 'iforest streamc requires JSON::MaybeXS for its wire protocol; install it: ' . $@ );
$JSON = JSON::MaybeXS->new( utf8 => 1, canonical => 1 );
$TIMEOUT = $opt->{'timeout'};
# Resolve the socket exactly as streamd does (keep in sync with it):
# without a set the flag is the socket file; with one it is the base
# run dir holding <set>.sock.
my $socket;
if ( defined $opt->{'set'} ) {
my $run = defined $opt->{'socket'} ? $opt->{'socket'} : '/var/run/iforest_streamd';
$socket = File::Spec->catfile( $run, $opt->{'set'} . '.sock' );
} else {
$socket = defined $opt->{'socket'} ? $opt->{'socket'} : '/var/run/iforest_streamd/streamd.sock';
}
die( '--socket, "'
. $socket
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
# messages, but one that streams an endless line (or stops reading its
# replies) gets dropped instead of eating the daemon's memory.
use constant MAX_INBUF => 16 * 1024 * 1024;
use constant MAX_OUTBUF => 16 * 1024 * 1024;
sub opt_spec {
return (
[
'set=s',
'Named instance. Appended to --model-dir, and the socket/pid become <set>.sock / <set>.pid '
. 'under the run dir, so several daemons run side by side with no other flags. '
. 'Must match /\A[A-Za-z0-9+\-@_]+\z/.'
],
[
'socket=s',
'Unix domain socket to listen on; default /var/run/iforest_streamd/streamd.sock. With --set '
. 'this is instead the base run dir (default /var/run/iforest_streamd) the <set>.sock is created in.',
{ 'completion' => 'files' }
],
[
'pid=s',
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
iforest streamd --set web
iforest streamd --set dns --prototype dns-proto.json -c 0.02
Set names must match /\A[A-Za-z0-9+\-@_]+\z/; since the class has no
"." or "/", a set name can only ever create one new path segment.
Everything under --model-dir and the socket/pid directories is created
at startup when missing; when that fails (e.g. running unprivileged
with the /var defaults) the daemon dies immediately, before forking,
naming the directory and the flag to override.
';
} ## end sub description
sub validate {
my ( $self, $opt, $args ) = @_;
# Anchored with \A/\z rather than ^/$ ($ tolerates a trailing newline).
# The class has no '.' or '/', so a set name can only ever create one
# new path segment -- no traversal is expressible.
if ( defined( $opt->{'set'} ) && $opt->{'set'} !~ /\A[A-Za-z0-9+\-@_]+\z/ ) {
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
# JSON::MaybeXS is required lazily so a box without it still has a
# working iforest CLI (App::Cmd loads every command module up front).
eval { require JSON::MaybeXS; 1 }
or die( 'iforest streamd requires JSON::MaybeXS for its wire protocol; install it: ' . $@ );
$JSON = JSON::MaybeXS->new( utf8 => 1, canonical => 1, allow_nonref => 0 );
%OPT = %$opt;
# --set turns --socket/--pid into base run dirs holding <set>.sock /
# <set>.pid and appends the set name to --model-dir, so several named
# daemons run side by side with no other flags. Without a set the
# flags are the socket/pid files themselves, defaulting as documented.
if ( defined $OPT{'set'} ) {
my $run = defined $OPT{'socket'} ? $OPT{'socket'} : '/var/run/iforest_streamd';
$OPT{'socket'} = File::Spec->catfile( $run, $OPT{'set'} . '.sock' );
my $prun = defined $OPT{'pid'} ? $OPT{'pid'} : '/var/run/iforest_streamd';
$OPT{'pid'} = File::Spec->catfile( $prun, $OPT{'set'} . '.pid' );
$OPT{'model_dir'} = File::Spec->catdir( $OPT{'model_dir'}, $OPT{'set'} );
} else {
$OPT{'socket'} = '/var/run/iforest_streamd/streamd.sock' unless defined $OPT{'socket'};
$OPT{'pid'} = '/var/run/iforest_streamd/streamd.pid' unless defined $OPT{'pid'};
}
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
_log('bye');
return 1;
} ## end sub execute
#-------------------------------------------------------------------------------
# startup helpers
#-------------------------------------------------------------------------------
sub _ensure_dir {
my ( $dir, $flag ) = @_;
if ( !-d $dir ) {
my $err;
make_path( $dir, { mode => oct('0755'), error => \$err } );
die( 'could not create "'
. $dir
. '" (needed for '
. $flag
. '); create it, fix permissions, or point '
. $flag
. ' somewhere writable'
. "\n" )
if !-d $dir;
} ## end if ( !-d $dir )
die( '"' . $dir . '" (needed for ' . $flag . ') is not writable; fix permissions or override ' . $flag . "\n" )
unless -w $dir;
return 1;
} ## end sub _ensure_dir
# Classic double-fork daemonization. The parents leave via POSIX::_exit
# so no END blocks (Inline's, App::Cmd's) run twice.
sub _daemonize {
defined( my $pid = fork() ) or die( 'fork failed: ' . $! . "\n" );
POSIX::_exit(0) if $pid;
setsid() or die( 'setsid failed: ' . $! . "\n" );
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
use constant _LOG2 => log(2);
# DBL_EPSILON, added to the normalisation factor before dividing so a
# just-started model (normaliser 0) yields well-defined scores instead of
# a division by zero -- the same guard the reference implementation uses.
use constant _EPS => 2.220446049250313e-16;
# The online learn/unlearn/score-row XS functions were added to the C
# backend after the batch-scoring ones, so a prebuilt object installed
# from an older release can back $HAS_C while lacking them (the parent
# trusts a flag-matched prebuilt object without inspecting its symbol
# set). Probe once at load: without them, use_c still accelerates the
# packed-snapshot batch scoring -- those functions have been in the
# object all along -- and learning quietly stays pure Perl instead of
# crashing on an undefined XS sub. Rebuilding/reinstalling (or
# IF_RUNTIME_BUILD=1) restores the full set.
use constant _HAS_ONLINE_XS => defined &Algorithm::Classifier::IsolationForest::online_learn_row_xs ? 1 : 0;
=head1 NAME
Algorithm::Classifier::IsolationForest::Online - Online (streaming) Isolation Forest anomaly detection
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
default :: 1.0
- seed :: optional integer to seed srand with, for reproducible trees
given the same stream in the same order. Processed via
abs(int()). Seeding happens here in new(), since there is no
fit() to do it in.
default :: undef
- contamination :: expected fraction of anomalies, in (0, 0.5]. When
set, the first predict()-family call learns a score threshold
that flags this fraction of the current window, and uses it as
the default cutoff. The threshold does NOT track the stream
automatically afterwards; call relearn_threshold() to refresh
it. undef => no learned threshold (predict() falls back to
0.5).
default :: undef
- missing :: how learn() treats undef (missing) feature cells. Scoring
always tolerates undef (mapped to 0), matching the parent
class's long-standing behaviour.
die :: croak if a learned point contains an undef cell
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
return ( $scores, $labels );
} ## end if ( $threshold > 0 && $threshold < 1 && $self...)
my $scores = $self->score_samples($data);
my @labels = map { $_ >= $threshold ? 1 : 0 } @$scores;
return ( $scores, \@labels );
} ## end sub score_predict_split
=head2 relearn_threshold(\@data)
Re-derives the contamination decision threshold so it flags the requested
fraction of the current window (or of C<\@data>, when passed). Call this
after the stream has drifted, or on whatever cadence threshold freshness
matters; learning alone never moves the threshold.
Requires C<contamination> to have been set. With C<< window_size => 0 >>
no window is retained, so C<\@data> must be supplied.
Returns C<$self>, so it chains.
$oif->relearn_threshold;
t/01-accel-flags.t view on Meta::CPAN
#!perl
# 01-accel-flags.t
#
# Sanity-checks the $HAS_C / $HAS_OPENMP / $HAS_SIMD package variables
# that record what the Inline::C build picked up at module load. These
# are read by `iforest accel` and by any user code that wants to make
# decisions based on which backend is active.
#
# What we verify (always):
# * the three vars are defined and 0/1-valued
# * SIMD => OpenMP (`#pragma omp simd` is gated on _OPENMP)
# * OpenMP => Inline::C (OpenMP only matters with the C backend)
t/01-accel-flags.t view on Meta::CPAN
ok( defined $has_simd, '$HAS_SIMD is defined' );
for my $pair ( [ '$HAS_C', $has_c ], [ '$HAS_OPENMP', $has_openmp ], [ '$HAS_SIMD', $has_simd ], ) {
my ( $name, $val ) = @$pair;
ok( $val == 0 || $val == 1, "$name is 0 or 1 (got '$val')" );
}
ok( !$has_openmp || $has_c, 'OpenMP implies Inline::C (parallel scoring needs the C backend)' );
ok( !$has_simd || $has_openmp, 'SIMD implies OpenMP (omp simd pragma is gated on _OPENMP)' );
diag( sprintf 'Active backend flags: HAS_C=%d HAS_OPENMP=%d HAS_SIMD=%d', $has_c, $has_openmp, $has_simd );
done_testing;
t/02-accel-selection.t view on Meta::CPAN
#!perl
# 02-accel-selection.t
#
# Exercises the per-instance acceleration selection knobs `use_c` and
# `use_openmp` exposed by new() and verifies they actually steer which
# code path runs:
#
# * Defaults come from the package flags $HAS_C / $HAS_OPENMP.
# * use_c => 0 disables the Inline::C scoring backend even when the
# module compiled it in. After fit() such an instance has no
# _c_nodes attached, so we know scoring is hitting the pure-Perl
# fallback.
# * use_c => 1 is honoured when $HAS_C is set, ignored (clamped via
# truthiness) otherwise.
# * use_openmp => 0 keeps the C tree-walk serial without disabling
# the C backend itself.
# * C-backed and Perl-fallback scoring agree -- when the C backend
# compiled successfully we should be able to flip use_c off and
# get the same scores back from the pure-Perl path.
# * pack_data() refuses to run on a use_c => 0 instance (it needs
# the C backend).
# * The bundled `iforest accel` CLI command runs cleanly and reports
# a status consistent with the package flags.
use strict;
use warnings;
use Test::More;
use File::Spec;
use Algorithm::Classifier::IsolationForest;
my $CLASS = 'Algorithm::Classifier::IsolationForest';
t/02-accel-selection.t view on Meta::CPAN
my $HAS_SIMD = $Algorithm::Classifier::IsolationForest::HAS_SIMD ? 1 : 0;
# Small but non-trivial dataset shared by every subtest below. A handful
# of obvious outliers tacked on the end of a uniform cluster keeps the
# scores well separated so cross-backend comparisons are unambiguous.
srand(11);
my @data;
push @data, [ rand(), rand(), rand() ] for 1 .. 60;
push @data, [ 12, 12, 12 ], [ -11, -11, -11 ], [ 10, -10, 9 ];
subtest 'defaults: _use_c / _use_openmp follow the package flags' => sub {
my $f = $CLASS->new( n_trees => 20, sample_size => 32, seed => 3 );
is( $f->{_use_c}, $HAS_C, '_use_c defaults to $HAS_C' );
is( $f->{_use_openmp}, $HAS_OPENMP, '_use_openmp defaults to $HAS_OPENMP' );
};
subtest 'use_c => 0 forces the pure-Perl path' => sub {
my $f = $CLASS->new(
n_trees => 20,
sample_size => 32,
seed => 3,
t/02-accel-selection.t view on Meta::CPAN
my $scores = $f->score_samples( \@data );
is( ref $scores, 'ARRAY', 'score_samples returns an arrayref' );
is( scalar @$scores, scalar @data, 'one score per sample' );
my $bad = grep { !defined $_ || $_ <= 0 || $_ > 1 } @$scores;
is( $bad, 0, 'every Perl-path score is in (0, 1]' );
}; ## end 'use_c => 0 forces the pure-Perl path' => sub
subtest 'use_c => 0 propagates through reload (from_json/load)' => sub {
# An instance with use_c off should still serialise and reload, and the
# reloaded model's runtime preference comes from the *current* package
# flags (from_json wires _use_c => $HAS_C). We're really checking that
# the round trip doesn't crash and produces a working model.
my $f = $CLASS->new(
n_trees => 12,
sample_size => 24,
seed => 5,
use_c => 0,
);
$f->fit( \@data );
my $json = $f->to_json;
my $reloaded = $CLASS->from_json($json);
is( $reloaded->{_use_c}, $HAS_C, 'from_json picks up the current $HAS_C, not the saved instance flag' );
my $a = $f->score_samples( \@data );
my $b = $reloaded->score_samples( \@data );
is( scalar @$a, scalar @$b, 'same row count after reload' );
}; ## end 'use_c => 0 propagates through reload (from_json/load)' => sub
SKIP: {
skip 'no Inline::C backend compiled in', 1 unless $HAS_C;
subtest 'use_c => 1 honoured when $HAS_C is set' => sub {
t/02-accel-selection.t view on Meta::CPAN
sample_size => 32,
seed => 3,
use_openmp => 1,
);
is( $f->{_use_openmp}, 1, '_use_openmp is 1 after use_openmp => 1' );
};
} ## end SKIP:
subtest 'use_openmp clamped to 0 when use_c is off' => sub {
# OpenMP only matters with the C tree walk; if the C backend is off
# the OpenMP flag is meaningless, so the constructor should clear it
# rather than leaving it set to a value that never gets read.
my $f = $CLASS->new(
n_trees => 10,
sample_size => 16,
seed => 1,
use_c => 0,
use_openmp => 1,
);
is( $f->{_use_c}, 0, '_use_c is 0' );
is( $f->{_use_openmp}, 0, '_use_openmp clamped to 0 since C backend is off' );
}; ## end 'use_openmp clamped to 0 when use_c is off' => sub
subtest 'use_c => 1 clamped against $HAS_C in the constructor' => sub {
# Fake "no Inline::C compiled" by localising the package flags. The
# XS subs themselves remain defined in this process (they were loaded
# at module init), but the constructor's contract is to clamp against
# $HAS_C so a fresh build without Inline::C wouldn't end up calling
# an undefined sub at score time.
local $Algorithm::Classifier::IsolationForest::HAS_C = 0;
local $Algorithm::Classifier::IsolationForest::HAS_OPENMP = 0;
my $f = $CLASS->new(
n_trees => 10,
sample_size => 16,
seed => 1,
use_c => 1,
use_openmp => 1,
);
is( $f->{_use_c}, 0, 'use_c => 1 clamped to 0 when $HAS_C is 0' );
is( $f->{_use_openmp}, 0, 'use_openmp => 1 clamped to 0 when $HAS_OPENMP is 0' );
# Defaults follow the (faked) flags too.
my $g = $CLASS->new( n_trees => 10, sample_size => 16, seed => 1 );
is( $g->{_use_c}, 0, 'default _use_c follows the faked $HAS_C' );
is( $g->{_use_openmp}, 0, 'default _use_openmp follows the faked $HAS_OPENMP' );
}; ## end 'use_c => 1 clamped against $HAS_C in the constructor' => sub
subtest 'use_openmp => 1 clamped against $HAS_OPENMP' => sub {
# $HAS_C stays on so the C backend is still picked up; only OpenMP
# is faked off. use_openmp => 1 should clamp to 0.
local $Algorithm::Classifier::IsolationForest::HAS_OPENMP = 0;
t/02-accel-selection.t view on Meta::CPAN
seed => 9,
use_c => 0,
);
$f->fit( \@data );
eval { $f->pack_data( \@data ) };
like( $@, qr/requires the Inline::C backend/, 'pack_data refuses to run without the C backend' );
}; ## end 'pack_data croaks when use_c is off' => sub
# ------------------------------------------------------------------------
# CLI: `iforest accel` should run cleanly and report a status consistent
# with the package flags this process sees. We bypass it entirely if
# bin/iforest isn't there (e.g. unusual install layouts).
# ------------------------------------------------------------------------
SKIP: {
my $bin = File::Spec->rel2abs('bin/iforest');
skip "bin/iforest not found", 1 unless -x $bin;
subtest 'iforest accel CLI reports a consistent status' => sub {
my $out = `$^X -Ilib $bin accel 2>&1`;
is( $?, 0, 'iforest accel exits 0' );
t/02-accel-selection.t view on Meta::CPAN
like( $out, qr/Inline::C\s*:/, 'mentions Inline::C' );
like( $out, qr/OpenMP\s*:/, 'mentions OpenMP' );
like( $out, qr/SIMD\s*:/, 'mentions SIMD' );
like( $out, qr/C object\s*:/, 'mentions the C object source' );
like( $out, qr/Active backend:/, 'prints an Active backend line' );
# The C object line must always resolve to one of the three
# states, consistent with the availability row in the same
# output (the CLI runs in its own process, so we compare the
# CLI's output against itself, not against this process's
# flags -- prebuilt vs runtime may legitimately differ).
if ( $out =~ /Inline::C\s*:\s*available/ ) {
like(
$out,
qr/C object\s*:\s*(prebuilt at install time|compiled at run time)/,
'C object line says prebuilt or runtime when C is active'
);
like(
$out,
qr/Active backend:.*-- (prebuilt at install time|compiled at run time)/,
'Active backend summary includes the C object source'
);
} else {
like( $out, qr/C object\s*:\s*none/, 'C object line says none without a C backend' );
}
# Cross-check the per-feature status lines against the package
# flags the test process observed. This is what makes this test
# actually verify selection rather than just "doesn't crash".
if ($HAS_C) {
like( $out, qr/Inline::C\s*:\s*available/, 'CLI reports Inline::C available, matching $HAS_C' );
} else {
like( $out, qr/Inline::C\s*:\s*not available/, 'CLI reports Inline::C not available, matching $HAS_C' );
}
if ($HAS_OPENMP) {
like( $out, qr/OpenMP\s*:\s*available/, 'CLI reports OpenMP available, matching $HAS_OPENMP' );
} else {
like( $out, qr/OpenMP\s*:\s*not available/, 'CLI reports OpenMP not available, matching $HAS_OPENMP' );
t/04-accel-tuning.t view on Meta::CPAN
local %ENV = %ENV;
delete @ENV{
qw(IF_NO_C IF_OPT IF_ARCH IF_NATIVE
IF_NO_OPENMP IF_RUNTIME_BUILD IF_INSTALL_BUILD)
};
@ENV{ keys %env } = values %env;
my $out = `$^X -Ilib "$path" 2>&1`;
return ( $out, $? );
} ## end sub run_child
# Expected flag composition mirrors the module's: the *defaults* come
# from the generated BuildFlags module when present (a tree configured
# with `IF_ARCH=... perl Makefile.PL` has that arch baked in as the
# default, and invalid runtime values must fall back to it, not to a
# hard-coded -O3), and any -march is always accompanied by
# -ffp-contract=off so FMA contraction can't break the C-vs-Perl
# bit-parity guarantees.
my ( $DEF_OPT, $DEF_ARCH ) = ( '-O3', '' );
{
local $@;
my $rec = eval {
require Algorithm::Classifier::IsolationForest::BuildFlags;
Algorithm::Classifier::IsolationForest::BuildFlags::flags();
};
if ( ref $rec eq 'HASH' ) {
$DEF_OPT = $rec->{opt} if defined $rec->{opt};
$DEF_ARCH = $rec->{arch} if defined $rec->{arch};
}
}
sub compose_flags {
my ( $opt, $arch ) = @_;
return $opt . ( length $arch ? " -march=$arch -ffp-contract=off" : '' );
}
subtest 'IF_NO_C=1 skips the C backend entirely' => sub {
my ( $out, $status ) = run_child( IF_NO_C => 1 );
is( $status, 0, 'child exits cleanly' ) or diag($out);
like( $out, qr/HAS_C=0/, 'HAS_C is 0' );
like( $out, qr/OPT_LEVEL=\s*$/m, 'OPT_LEVEL is empty' );
};
subtest 'IF_OPT overrides the optimisation level' => sub {
my ( $out, $status ) = run_child( IF_OPT => '-O2' );
is( $status, 0, 'child exits cleanly' ) or diag($out);
like( $out, qr/HAS_C=1/, 'HAS_C is 1' );
my $want = compose_flags( '-O2', $DEF_ARCH );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'OPT_LEVEL reflects -O2' );
};
subtest 'IF_OPT rejects an invalid value instead of passing it through' => sub {
my ( $out, $status ) = run_child( IF_OPT => '-O3; touch /tmp/pwned-opt' );
is( $status, 0, 'child exits cleanly despite the bad value' )
or diag($out);
ok( !-e '/tmp/pwned-opt', 'no injected command executed' );
like( $out, qr/ignoring invalid IF_OPT/, 'warns about the bad value' );
my $want = compose_flags( $DEF_OPT, $DEF_ARCH );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'falls back to the configured default opt level' );
unlink '/tmp/pwned-opt' if -e '/tmp/pwned-opt';
}; ## end 'IF_OPT rejects an invalid value instead of passing it through' => sub
subtest 'IF_ARCH adds -march=<value>' => sub {
my ( $out, $status ) = run_child( IF_ARCH => 'x86-64-v2' );
is( $status, 0, 'child exits cleanly' ) or diag($out);
like( $out, qr/HAS_C=1/, 'HAS_C is 1' );
my $want = compose_flags( $DEF_OPT, 'x86-64-v2' );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'OPT_LEVEL includes -march=x86-64-v2 (with -ffp-contract=off)' );
};
subtest 'IF_ARCH rejects an invalid value instead of passing it through' => sub {
my ( $out, $status ) = run_child( IF_ARCH => 'native; touch /tmp/pwned-arch' );
is( $status, 0, 'child exits cleanly despite the bad value' )
or diag($out);
ok( !-e '/tmp/pwned-arch', 'no injected command executed' );
like( $out, qr/ignoring invalid IF_ARCH/, 'warns about the bad value' );
my $want = compose_flags( $DEF_OPT, $DEF_ARCH );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'falls back to the configured default arch' );
unlink '/tmp/pwned-arch' if -e '/tmp/pwned-arch';
}; ## end 'IF_ARCH rejects an invalid value instead of passing it through' => sub
subtest 'IF_ARCH=none opts out of any configured default arch' => sub {
my ( $out, $status ) = run_child( IF_ARCH => 'none' );
is( $status, 0, 'child exits cleanly' ) or diag($out);
my $want = compose_flags( $DEF_OPT, '' );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'OPT_LEVEL has no -march at all' );
};
subtest 'IF_NATIVE is shorthand for -march=native' => sub {
my ( $out, $status ) = run_child( IF_NATIVE => 1 );
is( $status, 0, 'child exits cleanly' ) or diag($out);
my $want = compose_flags( $DEF_OPT, 'native' );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'OPT_LEVEL includes -march=native' );
};
subtest 'IF_ARCH takes precedence over IF_NATIVE when both are set' => sub {
my ( $out, $status ) = run_child( IF_NATIVE => 1, IF_ARCH => 'x86-64-v2' );
is( $status, 0, 'child exits cleanly' ) or diag($out);
my $want = compose_flags( $DEF_OPT, 'x86-64-v2' );
like( $out, qr/OPT_LEVEL=\Q$want\E\s*$/m, 'OPT_LEVEL uses IF_ARCH, not native' );
};
done_testing;
t/30-scoring.t view on Meta::CPAN
my $bad = grep { $_ ne '0' && $_ ne '1' } @$labels;
is( $bad, 0, 'every label is exactly 0 or 1' );
};
subtest "[$be_name] predict honours an explicit threshold" => sub {
# Scores are always in (0, 1], so these thresholds give deterministic,
# platform-independent results regardless of the random partitioning.
my $all_one = $f->predict( \@data, -1 );
my $all_zero = $f->predict( \@data, 100 );
is( sum(@$all_one), scalar @data, 'threshold below every score flags all samples (label 1)' );
is( sum(@$all_zero), 0, 'threshold above every score flags nothing (label 0)' );
};
subtest "[$be_name] predict defaults to a 0.5 threshold without contamination" => sub {
my $scores = $f->score_samples( \@data );
my $labels = $f->predict( \@data ); # no threshold, no contamination
my $mismatch = 0;
for my $i ( 0 .. $#$scores ) {
my $expected = $scores->[$i] >= 0.5 ? 1 : 0;
$mismatch++ if $labels->[$i] != $expected;
}
t/37-majority-voting.t view on Meta::CPAN
# * constructor validation of the voting knob
# * score_samples returns the anomaly vote fraction: [0, 1], discrete
# in steps of 1/n_trees, higher for obvious outliers
# * predict labels are the majority of the per-tree votes, consistent
# with the vote fractions, in both axis and extended mode
# * score_predict_samples / score_predict_split agree with
# score_samples + predict
# * C-backed and pure-Perl paths produce identical votes and labels
# * persistence: voting survives a to_json/from_json round trip, and
# models saved before the knob existed load as 'mean'
# * contamination learns a per-tree cutoff that flags roughly the
# requested fraction of the training set (majority pivots are
# quantized, so ties can shift the count to the nearest gap)
# * a higher per-tree threshold never flags more points
# * set_voting switches an existing model and recalibrates the
# contamination threshold for the mode it was set to
# * the tagged single-row helpers work under majority voting
# * the CLI accepts --voting and stores it on the model
use strict;
use warnings;
use Test::More;
use File::Spec;
t/37-majority-voting.t view on Meta::CPAN
# Labels must be the majority relation applied to the fractions:
# anomalous iff votes >= int(t/2) + 1, i.e. fraction > 0.5.
my $maj = int( $t / 2 ) + 1;
my $mismatches = grep {
my $votes = int( $scores->[$_] * $t + 0.5 );
( $votes >= $maj ? 1 : 0 ) != $labels->[$_]
} 0 .. $#$labels;
is( $mismatches, 0, 'labels equal the majority of the votes' );
ok( ( grep { $labels->[$_] == 1 } @outlier_idx ) == @outlier_idx, 'all planted outliers are flagged' );
# 0.5 is a weak per-tree bar (the paper recommends 0.6 as the
# decision threshold), so allow some inlier false alarms at the
# default and check the sharper separation at 0.6.
my $inlier_flags = grep { $labels->[$_] } 0 .. 59;
cmp_ok( $inlier_flags, '<=', 15, 'default cutoff flags a minority of the inliers' );
my $labels06 = $f->predict( \@data, 0.6 );
ok( ( grep { $labels06->[$_] == 1 } @outlier_idx ) == @outlier_idx,
'outliers still flagged at threshold 0.6' );
my $inlier_flags06 = grep { $labels06->[$_] } 0 .. 59;
cmp_ok( $inlier_flags06, '<=', 3, 'few or no inliers flagged at threshold 0.6' );
# The paired and split shapes agree with the flat ones.
my $pairs = $f->score_predict_samples( \@data );
my ( $s2, $l2 ) = $f->score_predict_split( \@data );
my $pair_bad = grep {
abs( $pairs->[$_][0] - $scores->[$_] ) > 1e-12
|| $pairs->[$_][1] != $labels->[$_]
|| abs( $s2->[$_] - $scores->[$_] ) > 1e-12
|| $l2->[$_] != $labels->[$_]
} 0 .. $#$labels;
t/37-majority-voting.t view on Meta::CPAN
sample_size => 64,
seed => 42,
voting => 'majority',
contamination => 0.05,
)->fit( \@data );
ok( defined $f->decision_threshold, 'a decision threshold was learned' );
cmp_ok( $f->decision_threshold, '>', 0, 'threshold is positive' );
cmp_ok( $f->decision_threshold, '<', 1, 'threshold is below 1' );
my $flags = $f->predict( \@data );
my $flagged = grep { $_ } @$flags;
my $k = int( 0.05 * scalar(@data) + 0.5 );
# Majority pivots are quantized, so ties at the boundary can shift the
# attainable count off k -- but it must stay in the neighbourhood and
# the planted outliers must be inside it.
cmp_ok( $flagged, '>=', 1, 'at least one training point is flagged' );
cmp_ok( $flagged, '<=', 3 * $k, 'flagged count stays near the requested fraction' );
ok( ( grep { $flags->[$_] == 1 } @outlier_idx ) == @outlier_idx, 'the planted outliers are flagged' );
}; ## end 'contamination learns a per-tree cutoff' => sub
subtest 'higher per-tree threshold never flags more points' => sub {
my $f = $CLASS->new(
n_trees => 50,
sample_size => 32,
seed => 31,
voting => 'majority',
)->fit( \@data );
my $low = grep { $_ } @{ $f->predict( \@data, 0.45 ) };
my $mid = grep { $_ } @{ $f->predict( \@data, 0.55 ) };
my $high = grep { $_ } @{ $f->predict( \@data, 0.70 ) };
cmp_ok( $low, '>=', $mid, 'flag count non-increasing from 0.45 to 0.55' );
cmp_ok( $mid, '>=', $high, 'flag count non-increasing from 0.55 to 0.70' );
}; ## end 'higher per-tree threshold never flags more points' => sub
subtest 'set_voting switches an existing model' => sub {
# A model switched to a mode reproduces one fit directly in that mode:
# the trees are voting-independent, and set_voting relearns the
# contamination threshold against the same training data.
my %args = (
n_trees => 100,
sample_size => 64,
seed => 42,
contamination => 0.05,
t/39-online-stream.t view on Meta::CPAN
n_trees => 50,
window_size => 512,
max_leaf_samples => 32,
contamination => 0.05,
);
$m->learn( cluster( 600, 0 ) );
is( $m->decision_threshold, undef, 'threshold not learned until a predict-family call' );
my $labels = $m->predict( [ [ 0, 0 ], [ 7, 7 ] ] );
ok( defined $m->decision_threshold, 'first predict learned the threshold from the window' );
is_deeply( $labels, [ 0, 1 ], 'inlier passes, outlier flagged at the learned threshold' );
# The learned cutoff should flag roughly the contamination fraction of
# the window itself.
my $flags = $m->predict( $m->{window} );
my $rate = 0;
$rate += $_ for @$flags;
$rate /= scalar @$flags;
cmp_ok( $rate, '>=', 0.02, 'window flag rate not far below contamination' );
cmp_ok( $rate, '<=', 0.09, 'window flag rate not far above contamination' );
# relearn_threshold tracks drift.
my $old_thr = $m->decision_threshold;
$m->learn( cluster( 600, 6 ) );
my $ret = $m->relearn_threshold;
is( $ret, $m, 'relearn_threshold chains' );
isnt( $m->decision_threshold, $old_thr, 'threshold moved with the stream' );
is( $m->predict( [ [ 6, 6 ] ] )->[0], 0, 'post-drift centre passes at the refreshed threshold' );
ok(
t/40-anomaly-detection.t view on Meta::CPAN
cmp_ok( $mean_out, '>', $mean_in + 0.2, 'outliers score clearly higher on average than inliers' );
cmp_ok( max(@$in_scores), '<', 0.55, 'inliers stay well below the 0.5 anomaly line' );
cmp_ok( min(@$out_scores), '>', 0.6, 'outliers sit well above the 0.5 anomaly line' );
cmp_ok( min(@$out_scores), '>', max(@$in_scores), 'every outlier scores higher than every inlier' );
# predict() with the default 0.5 cutoff should recover the labelling.
is(
sum( @{ $f->predict( \@outliers ) } ),
scalar @outliers,
'predict() flags all outliers at the default cutoff'
);
cmp_ok(
sum( @{ $f->predict( \@inliers ) } ),
'<',
0.05 * @inliers,
'predict() flags very few inliers (< 5%)'
);
}; ## end "[$be_name] axis-parallel Isolation Forest separates outliers from inliers" => sub
subtest "[$be_name] Extended Isolation Forest also separates the outliers" => sub {
my $f = $CLASS->new(
n_trees => 100,
sample_size => 256,
mode => 'extended',
seed => 7,
use_c => $USE_C,
t/50-contamination.t view on Meta::CPAN
subtest 'predict() uses the learned threshold by default' => sub {
my $contam = 0.05;
my $f = $CLASS->new(
n_trees => 100,
sample_size => 256,
contamination => $contam,
seed => 5,
);
$f->fit( \@data );
my $flagged = sum( @{ $f->predict( \@data ) } );
my $target = $contam * scalar @data;
# The learned cutoff should flag roughly the requested fraction -- not
# exact, but in the right ballpark (within a few points either way).
cmp_ok( $flagged, '>=', 1, 'at least one point is flagged' );
cmp_ok( abs( $flagged - $target ), '<=', 5, "fraction flagged (~$flagged) is close to the requested $target" );
# An explicit threshold still overrides the learned one.
is( sum( @{ $f->predict( \@data, 100 ) } ),
0, 'an explicit threshold overrides the learned contamination cutoff' );
}; ## end 'predict() uses the learned threshold by default' => sub
done_testing;
t/80-sklearn-comparison-undef.t view on Meta::CPAN
}
# ---- 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};
my @perl_in = @{$perl_scores}[ 0 .. $n_in - 1 ];
my @perl_out = @{$perl_scores}[ $n_in .. $n_in + $n_out - 1 ];
my $gap_min = $ds->{mean_gap_min};
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} };
if ( defined $sk_scores
t/80-sklearn-comparison.t view on Meta::CPAN
my @sk_rank = sort { $sk_all->[$a] <=> $sk_all->[$b] } 0 .. $#$sk_all;
my %sk_top = map { $_ => 1 } @sk_rank[ 0 .. $n_out - 1 ];
my $perl_caught = grep { $perl_top{$_} } $n_in .. $n_in + $n_out - 1;
my $sk_caught = grep { $sk_top{$_} } $n_in .. $n_in + $n_out - 1;
is( $perl_caught, $n_out, "Perl top-$n_out contains all $n_out outlier points" );
is( $sk_caught, $n_out, "sklearn top-$n_out contains all $n_out outlier points" );
}; ## end "both models rank all $n_out outliers in the top-$n_out anomalies" => sub
subtest 'Perl predict at 0.5 threshold flags all outliers and almost no inliers' => sub {
my $in_labels = $f->predict( $ds->{inliers} );
my $out_labels = $f->predict( $ds->{outliers} );
is( sum(@$out_labels), $n_out, "Perl predict() flags all $n_out outliers at the 0.5 threshold" );
cmp_ok( sum(@$in_labels), '<', 0.05 * $n_in, 'fewer than 5% of inliers are flagged by Perl predict()' );
};
subtest 'Spearman rank correlation between Perl and sklearn scores >= 0.85' => sub {
# Negate sklearn scores so both vectors point in the same direction
# (higher value = more anomalous) before ranking.
my @neg_sk = map { -$_ } @$sk_all;
my $rho = spearman_rho( $perl_all_scores, \@neg_sk );
cmp_ok( $rho, '>=', 0.85, sprintf( 'Spearman rho(Perl, -sklearn) = %.4f (must be >= 0.85)', $rho ) );
};
} ## end sub run_dataset_tests
t/90-cli-commands.t view on Meta::CPAN
like( $out, qr/munger_module_version\s+[\d.]/, 'module version shown' );
};
subtest 'stream --mungers creates and resumes a munged online model' => sub {
my $out
= `$^X -Ilib $bin stream -i $raw_csv -m $momodel -n 20 --window 64 --eta 16 -s 7 -t method -t path_len -t bytes --mungers $munger_json 2>&1`;
is( $?, 0, 'stream --mungers exits 0' ) or diag $out;
ok( -s $momodel, 'online model written' );
# Resume: the model carries its spec, so raw CSV still works with
# no --mungers flag.
my $out2 = `$^X -Ilib $bin stream -i $raw_csv -m $momodel 2>&1`;
is( $?, 0, 'resumed stream exits 0' ) or diag $out2;
my @lines = split /\n/, $out2;
is( scalar @lines, 81, 'one output row per input row on resume' );
}; ## end 'stream --mungers creates and resumes a munged online model' => sub
} ## end SKIP:
# --- prototype workflow: fit/stream --prototype, proto command ----------
{
my $bproto = "$tmp/proto_batch.json";
t/90-cli-commands.t view on Meta::CPAN
ok( -s $pomodel, 'online model written' );
my $info = `$^X -Ilib $bin info -m $pomodel 2>&1`;
like( $info, qr/type\s+online/, 'created model is online' );
like( $info, qr/schema_version\s+s2/, 'schema_version carried' );
like( $info, qr/schema_description\s+online metrics stream/, 'schema_description carried' );
like( $info, qr/window_size\s+64/, 'prototype param applied' );
# Resume ignores the creation knob, like the rest of them.
my $out2 = `$^X -Ilib $bin stream --prototype $oproto -i $train_csv -m $pomodel 2>&1`;
is( $?, 0, 'resumed stream with the flag still exits 0' ) or diag $out2;
$out = `$^X -Ilib $bin stream --prototype $bproto -i $train_csv -m $tmp/nope_online.json 2>&1`;
isnt( $?, 0, 'a batch prototype is refused by stream' );
like( $out, qr/use `iforest fit`/, 'error points at fit' );
}; ## end 'stream --prototype creates an online model' => sub
subtest 'proto --from-model extracts a working prototype' => sub {
my $extracted = "$tmp/extracted_proto.json";
my $out = `$^X -Ilib $bin proto --from-model $pmodel -o $extracted 2>&1`;
is( $?, 0, 'proto --from-model exits 0' ) or diag $out;
t/90-cli-commands.t view on Meta::CPAN
$out = `$^X -Ilib $bin proto --check $bad --from-model $pmodel 2>&1`;
isnt( $?, 0, 'combining --check and --from-model exits non-zero' );
like( $out, qr/exactly one of/, 'error explains the exclusivity' );
$out = `$^X -Ilib $bin proto 2>&1`;
isnt( $?, 0, 'neither switch exits non-zero' );
}; ## end 'proto --check rejects invalid input' => sub
}
# Ensure the module's HAS_C flag was probed before any SKIP block.
BEGIN { require Algorithm::Classifier::IsolationForest; }
done_testing;
t/91-streamd.t view on Meta::CPAN
close $cb;
is( stop_daemon($alpha), 0, 'alpha exits 0' );
is( stop_daemon($beta), 0, 'beta exits 0' );
ok( !-e "$tmp/alpha.sock" && !-e "$tmp/alpha.pid", 'alpha cleaned up its socket and pid' );
# Set names that could mangle paths are refused before anything runs.
for my $bad ( 'bad/name', 'a.b', '..' ) {
my $quoted = quotemeta $bad;
my $out = `$^X -Ilib $bin streamd -f --set $quoted 2>&1`;
isnt( $?, 0, "--set '$bad' exits non-zero" );
like( $out, qr/--set/, 'the error names the flag' );
}
}; ## end '--set runs named instances side by side' => sub
subtest 'default directories refused when not writable' => sub {
plan skip_all => 'running as root; the /var defaults would work'
if $> == 0;
plan skip_all => '/var/db/iforest_streamd is creatable here; nothing to refuse'
if -w '/var/db/iforest_streamd' || ( !-e '/var/db/iforest_streamd' && -w '/var/db' );
my $out = `$^X -Ilib $bin streamd -f 2>&1`;
isnt( $?, 0, 'streamd with unwritable default dirs exits non-zero' );
like( $out, qr/--model-dir/, 'the error names the flag to override' );
}; ## end 'default directories refused when not writable' => sub
done_testing;
( run in 2.795 seconds using v1.01-cache-2.11-cpan-600a1bdf6e4 )