Algorithm-Classifier-IsolationForest
view release on metacpan or search on metacpan
- 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
points through one tree at a time so each tree stays hot in
L1/L2 instead of being re-streamed from memory per point --
When a "work that uses the Library" uses material from a header file
that is part of the Library, the object code for the work may be a
derivative work of the Library even though the source code is not.
Whether this is true is especially significant if the work can be
linked without the Library, or if the work is itself a library. The
threshold for this to be true is not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and small inline
functions (ten lines or less in length), then the use of the object
file is unrestricted, regardless of whether it is legally a derivative
work. (Executables containing this object code plus portions of the
Library will still fall under Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of Section 6.
Any executables containing that work also fall under Section 6,
whether or not they are linked directly with the Library itself.
6. As an exception to the Sections above, you may also combine or
benchmarking/BenchAccel.pm view on Meta::CPAN
# Real timed run.
my $t0 = time;
$code->() for 1 .. $iters;
my $elapsed = ( time - $t0 ) || 1e-9;
$res{$name} = { iters => $iters, rate => $iters / $elapsed };
} ## end for my $name ( sort keys %$vars )
my @names = sort { $res{$a}{rate} <=> $res{$b}{rate} } keys %res;
my $name_w = 1;
for my $n (@names) { $name_w = length $n if length $n > $name_w }
my $col_w = $name_w < 8 ? 8 : $name_w;
printf " %-*s %10s", $name_w, '', 'Rate';
printf " %*s", $col_w, $_ for @names;
print "\n";
for my $a (@names) {
printf " %-*s %10s", $name_w, $a, _fmt_rate( $res{$a}{rate} );
for my $b (@names) {
if ( $a eq $b ) {
benchmarking/bench-axis-predict-accel.pl view on Meta::CPAN
my $models = build_models(
n_trees => 100,
sample_size => 256,
mode => 'axis',
seed => 1,
_data => $train,
);
for my $method (
qw(score_samples predict score_predict_samples
score_predict_split path_lengths)
)
{
printf "\n %s\n", $method;
my %v;
for my $accel ( sort keys %$models ) {
my $m = $models->{$accel};
if ( $method eq 'predict'
|| $method eq 'score_predict_samples'
|| $method eq 'score_predict_split' )
{
benchmarking/bench-extended-predict-accel.pl view on Meta::CPAN
my $models = build_models(
n_trees => 100,
sample_size => 256,
mode => 'extended',
seed => 1,
_data => $train,
);
for my $method (
qw(score_samples predict score_predict_samples
score_predict_split path_lengths)
)
{
printf "\n %s\n", $method;
my %v;
for my $accel ( sort keys %$models ) {
my $m = $models->{$accel};
if ( $method eq 'predict'
|| $method eq 'score_predict_samples'
|| $method eq 'score_predict_split' )
{
benchmarking/bench-online-score-accel.pl view on Meta::CPAN
# -----------------------------------------------------------------------
# 1. Scoring method comparison (1000 query points, snapshot reused)
# -----------------------------------------------------------------------
print "\n--- scoring methods (100 trees, 1000 query points, 5 features) ---\n";
srand(43);
my $q1k = make_data( 1000, 5 );
for my $method (
qw(score_samples predict score_predict_samples
score_predict_split path_lengths)
)
{
printf "\n %s\n", $method;
my %v;
for my $name ( keys %$models ) {
my $m = $models->{$name};
$v{$name} = sub { my @r = $m->$method($q1k); 1 };
}
wall_cmpthese( 1, \%v );
} ## end for my $method ( qw(score_samples predict score_predict_samples...))
benchmarking/bench-score.pl view on Meta::CPAN
#!/usr/bin/perl
# benchmarking/bench-score.pl
#
# Benchmarks the five public scoring/prediction methods:
# score_samples, predict, score_predict_samples, score_predict_split,
# path_lengths
#
# Sections:
# 1. Scoring method comparison -- which method has the lowest overhead
# 2. Query set size scaling -- throughput vs number of points scored
# 3. n_trees scaling on scoring -- effect of model size on score time
# 4. Feature count 2–10 -- fine-grained column-count sweep on scoring
#
# Models are pre-trained before any timing begins.
#
# Run with:
benchmarking/bench-score.pl view on Meta::CPAN
# -----------------------------------------------------------------------
print "\n--- scoring methods (n_trees=100, 1000 query points) ---\n";
my $m = $model{100};
wall_cmpthese(
-2,
{
'score_samples' => sub { $m->score_samples($q1k) },
'predict' => sub { $m->predict($q1k) },
'score_predict_samples' => sub { $m->score_predict_samples($q1k) },
'score_predict_split' => sub { $m->score_predict_split($q1k) },
'path_lengths' => sub { $m->path_lengths($q1k) },
}
);
# -----------------------------------------------------------------------
# 2. Query set size (n_trees=100, score_samples)
# -----------------------------------------------------------------------
print "\n--- query set size (n_trees=100, score_samples) ---\n";
wall_cmpthese(
-2,
{
benchmarking/bench-sklearn-scoring.pl view on Meta::CPAN
#
# The same training CSV and query CSVs are used by all sides so the
# comparison is on identical data. Models are pre-trained before any
# timing starts.
#
# Method correspondence:
# Perl score_samples <--> clf.score_samples(X) (same formula, opposite sign)
# Perl predict <--> clf.predict(X) (same semantics, 0/1 vs -1/+1)
# Perl score_predict_samples <--> (no sklearn equivalent)
# Perl score_predict_split <--> (no sklearn equivalent)
# Perl path_lengths <--> (no sklearn equivalent)
# (no Perl equivalent) <--> clf.decision_function(X) (threshold-shifted score)
#
# The ratio column shows sklearn ops/s / best-Perl ops/s.
# >1 means sklearn is faster; <1 means Perl is faster.
#
# Unavailable backends (Inline::C not installed, OpenMP not linked,
# scikit-learn not installed) are omitted from the table.
#
# Run with:
# perl -Ilib benchmarking/bench-sklearn-scoring.pl
benchmarking/bench-sklearn-scoring.pl view on Meta::CPAN
my $q = $exp->{query_data};
# Pure Perl
{
my $m = $exp->{pure_model};
$pure_pl{$key} = {
score_samples => wall_rate( sub { $m->score_samples($q) }, $BENCH_SECS ),
predict => wall_rate( sub { $m->predict($q) }, $BENCH_SECS ),
score_predict_samples => wall_rate( sub { $m->score_predict_samples($q) }, $BENCH_SECS ),
score_predict_split => wall_rate( sub { $m->score_predict_split($q) }, $BENCH_SECS ),
path_lengths => wall_rate( sub { $m->path_lengths($q) }, $BENCH_SECS ),
};
}
# C serial (single-threaded Inline::C)
if ($HAS_C) {
my $m = $exp->{c_model};
my $packed = $m->pack_data($q);
$c_pl{$key} = {
score_samples => wall_rate( sub { $m->score_samples($q) }, $BENCH_SECS ),
score_samples_packed => wall_rate( sub { $m->score_samples($packed) }, $BENCH_SECS ),
predict => wall_rate( sub { $m->predict($q) }, $BENCH_SECS ),
predict_packed => wall_rate( sub { $m->predict($packed) }, $BENCH_SECS ),
score_predict_samples => wall_rate( sub { $m->score_predict_samples($q) }, $BENCH_SECS ),
score_predict_split => wall_rate( sub { $m->score_predict_split($q) }, $BENCH_SECS ),
score_predict_split_packed => wall_rate( sub { $m->score_predict_split($packed) }, $BENCH_SECS ),
path_lengths => wall_rate( sub { $m->path_lengths($q) }, $BENCH_SECS ),
};
} ## end if ($HAS_C)
# C + OpenMP (parallel Inline::C)
if ($HAS_OPENMP) {
my $m = $exp->{omp_model};
my $packed = $m->pack_data($q);
$omp_pl{$key} = {
score_samples => wall_rate( sub { $m->score_samples($q) }, $BENCH_SECS ),
score_samples_packed => wall_rate( sub { $m->score_samples($packed) }, $BENCH_SECS ),
predict => wall_rate( sub { $m->predict($q) }, $BENCH_SECS ),
predict_packed => wall_rate( sub { $m->predict($packed) }, $BENCH_SECS ),
score_predict_samples => wall_rate( sub { $m->score_predict_samples($q) }, $BENCH_SECS ),
score_predict_split => wall_rate( sub { $m->score_predict_split($q) }, $BENCH_SECS ),
score_predict_split_packed => wall_rate( sub { $m->score_predict_split($packed) }, $BENCH_SECS ),
path_lengths => wall_rate( sub { $m->path_lengths($q) }, $BENCH_SECS ),
};
} ## end if ($HAS_OPENMP)
} ## end for my $exp (@experiments)
# -----------------------------------------------------------------------
# Display
# -----------------------------------------------------------------------
# Row layout: [ label, pure_key, c_key, omp_key, sklearn_key ]
# undef means "not applicable for this backend/side"
my @rows = (
[ 'score_samples', 'score_samples', 'score_samples', 'score_samples', 'score_samples' ],
[ 'score_samples (packed)', undef, 'score_samples_packed', 'score_samples_packed', undef ],
[ 'predict', 'predict', 'predict', 'predict', 'predict' ],
[ 'predict (packed)', undef, 'predict_packed', 'predict_packed', undef ],
[ 'score_predict_samples', 'score_predict_samples', 'score_predict_samples', 'score_predict_samples', undef ],
[ 'score_predict_split', 'score_predict_split', 'score_predict_split', 'score_predict_split', undef ],
[ 'score_predict_split (packed)', undef, 'score_predict_split_packed', 'score_predict_split_packed', undef ],
[ 'path_lengths', 'path_lengths', 'path_lengths', 'path_lengths', undef ],
[ 'decision_function', undef, undef, undef, 'decision_function' ],
);
my $MW = 28; # method column width
my $NW = 12; # numeric backend column width
my $SW = 14; # sklearn column width
my $RW = 8; # ratio column width
sub fmt_rate { defined $_[0] && $_[0] ? sprintf( '%.1f', $_[0] ) : '--' }
benchmarking/bench-streamd.pl view on Meta::CPAN
my $ETA = 32;
my $NF = 5;
my @TAGS = map { "f$_" } 0 .. $NF - 1;
# --- spawn the daemon -----------------------------------------------------
my $bin = "$FindBin::Bin/../src_bin/iforest";
die "cannot find $bin\n" unless -f $bin;
my $tmp = tempdir( CLEANUP => 1 );
my $sock = "$tmp/b.sock";
die "temp socket path too long for a Unix socket ($sock)\n" if length($sock) > 100;
my $daemon = fork();
die "fork failed: $!" unless defined $daemon;
if ( !$daemon ) {
open( STDOUT, '>>', "$tmp/streamd.log" ) or die $!;
open( STDERR, '>>', "$tmp/streamd.log" ) or die $!;
exec(
$^X, "-I$FindBin::Bin/../lib", $bin, 'streamd', '-f',
'--socket' => $sock,
'--pid' => "$tmp/b.pid",
benchmarking/bench-voting.pl view on Meta::CPAN
#!/usr/bin/perl
# benchmarking/bench-voting.pl
#
# Head-to-head comparison of mean aggregation (classic IForest) vs
# majority voting (MVIForest -- Chabchoub, Togbe, Boly & Chiky 2022) for
# both speed and detections.
#
# voting => 'majority' is aggregation-only: it builds the exact same
# trees as voting => 'mean' and differs solely in how the per-tree path
# lengths are combined at score/predict time. So a fair comparison holds
# the trees fixed (same seed + data) and varies only the aggregation.
#
# Two things are measured:
#
# 1. SPEED. predict() is where majority voting can win: it stops
# walking a point's trees as soon as the majority outcome is decided
# (the paper's "stop at majority"), whereas mean aggregation always
# walks every tree. score_samples() has no such early exit (the
# vote fraction needs the full count), so it is shown as a contrast.
# Timed across n_trees, query-set size, and feature count, under the
examples/README.md view on Meta::CPAN
```
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;
my $if = Algorithm::Classifier::IsolationForest->new(
n_trees => 100, # ensemble size
sample_size => 256, # sub-sample per tree (psi)
mode => 'axis', # or 'extended'
contamination => undef, # e.g. 0.05 to learn a threshold
seed => 42, # for reproducibility
);
$if->fit(\@data); # @data = ([f1, f2, ...], ...)
my $scores = $if->score_samples(\@data); # arrayref, each in (0, 1]
my $labels = $if->predict(\@data); # arrayref of 0/1
my $depths = $if->path_lengths(\@data); # arrayref, mean isolation depth
$if->save('model.json');
my $reloaded = Algorithm::Classifier::IsolationForest->load('model.json');
```
Scores near 1 are strong anomalies (isolated after only a few splits); scores
well below 0.5 are normal; ~0.5 means the point is hard to tell apart.
examples/server-metrics.pl view on Meta::CPAN
# --- fit ----------------------------------------------------------------------
my $iforest = Algorithm::Classifier::IsolationForest->new(
n_trees => 150,
sample_size => 256,
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";
examples/server-metrics.pl view on Meta::CPAN
$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
# Optional Inline::C accelerator for the scoring hot path.
#
# pack_input_xs(data_sv, out_sv, n_pts, n_feats, miss_mode, fill_sv)
# Walks the Perl arrayref-of-arrayrefs and writes a packed double buffer
# into out_sv. Replaces the dominant per-call Perl map-pack loop.
# miss_mode selects how an undef cell is packed: 0 => 0.0, 1 => the
# per-feature fill from fill_sv (impute), 2 => NaN (nan strategy).
#
# score_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
# n_pts, n_feats, n_trees, use_openmp)
# Sums path lengths for all n_pts query points across all n_trees trees
# in one call. Outer loop over points is OpenMP-parallel when the
# module was built with OpenMP (each iteration writes to a unique sm[i],
# so no synchronisation is needed). Tree pointers are extracted from
# the AVs before the parallel region; the parallel region touches only
# raw int / double buffers.
#
# vote_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
# n_pts, n_feats, n_trees, depth_cut, min_votes, use_openmp)
# Majority-voting (voting => 'majority') counterpart of score_all_xs:
# instead of summing path lengths it counts, per point, how many trees
# "vote anomalous" (path length <= depth_cut). min_votes == 0 writes
# the full vote count into sm[i]; min_votes > 0 writes a 0.0/1.0 label
# with per-point early exit once the majority outcome is decided --
# the MVIForest scoring loop. See the function's own comment.
#
# Node layout (6 doubles per node, "IF_NZ = 6"):
# leaf: [0, size, c(size), 0, 0, 0]
# axis: [1, attr, split, li, ri, 0]
# oblique: [2, coff, nf, li, ri, b]
#
# c(size) is the expected-path-length adjustment for a leaf holding
# `size` points, precomputed by _pack_tree (it involves a log(); doing
# it at pack time keeps transcendentals out of the per-point per-tree
# scoring loop). The fit-time TreeBuf writer leaves that slot 0 --
# its buffers are unpacked into Perl trees and re-packed by
# _pack_tree before score_all_xs ever sees them.
#
# Coefficient storage uses a Structure-of-Arrays layout: one int32 array
# per tree (feature indices, packed with 'l*') and one double array per
# tree (coefficients, packed with 'd*'). Both are indexed by `coff` --
# the same offset addresses paired entries in the two arrays. Splitting
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# the feature gather on xi[idx[k]] kept separate.
#
# Dense-pack fast path: when an oblique node uses every feature (the
# common case in extended mode with extension_level == n_features - 1),
# _pack_tree writes its coefficients in feature order so val[k] is the
# coefficient for feature k. score_all_xs detects this via `nf ==
# n_feats` and uses a no-gather dot product (dot += val[k] * xi[k])
# that vectorizes cleanly with FMA -- substantially faster than the
# sparse gather path on high-feature-count models.
# 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
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
}
sm = (const double*)SvPVbyte(sm_sv, tl);
out = (AV*)SvRV(out_rv);
av_clear(out);
if (n_pts > 0) av_extend(out, n_pts - 1);
for (i = 0; i < n_pts; i++) {
av_store(out, i, newSVnv(exp(-sm[i] * inv)));
}
}
/* finalize_path_lengths_xs(sm_sv, n_pts, t, out_rv)
*
* Same idea as finalize_scores_xs but writes sm[i] / t (the average path
* length across n_trees=t trees) instead of the exp normalisation. */
void finalize_path_lengths_xs(SV* sm_sv, int n_pts, double t, SV* out_rv){
STRLEN tl;
const double* sm;
AV* out;
int i;
if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
croak("finalize_path_lengths_xs: out must be an arrayref");
}
sm = (const double*)SvPVbyte(sm_sv, tl);
out = (AV*)SvRV(out_rv);
av_clear(out);
if (n_pts > 0) av_extend(out, n_pts - 1);
for (i = 0; i < n_pts; i++) {
av_store(out, i, newSVnv(sm[i] / t));
}
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
if (n_pts > 0) {
av_extend(scores, n_pts - 1);
av_extend(labels, n_pts - 1);
}
for (i = 0; i < n_pts; i++) {
av_store(scores, i, newSVnv(exp(-sm[i] * inv)));
av_store(labels, i, newSViv(sm[i] <= sum_threshold ? 1 : 0));
}
}
/* Walk one point through one tree; returns the path length (depth plus
* the precomputed c(leaf size) adjustment from the leaf record).
*
* Invariant: every feature index stored in a tree node is in
* [0, n_feats). fit() builds trees against n_features columns and
* pack_input_xs writes exactly that many doubles per row, and
* _resolve_input rejects PackedData with a mismatched feature count.
* So the loop can omit per-iteration bounds checks on attr / fi --
* this is what lets the oblique dot product vectorize cleanly under
* the omp-simd reductions below. */
#if defined(__GNUC__) || defined(__clang__)
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
}
xd = (const double*)SvPVbyte(x_sv, tl);
sm = (double*)SvPVbyte_force(sm_sv, tl);
/* Two loop shapes over the same per-point ascending-t additions --
* bit-identical results either way, so the size heuristic choosing
* between them can never change scores.
*
* Point-major (small forests): each point walks all trees with its
* path-length sum held in a register. Cheapest per walk, and the
* whole forest stays cache-resident across points anyway.
*
* Tree-blocked (large forests): once the forest outgrows L3, the
* point-major loop re-streams every tree's nodes and coefficients
* from memory for every point -- an extended-mode tree is ~56 KB
* at 16 features (24 KB nodes + 32 KB dense coefficients), and its
* per-tree scoring cost measured 2.2x worse at 400 trees than at
* 100. Walking a block of points through ONE tree at a time keeps
* that tree hot in L1/L2 while the block's rows stream through it
* (measured 3.1x faster at 400 extended trees, 20k points). The
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
}
}
}
}
}
/* vote_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
* n_pts, n_feats, n_trees, depth_cut, min_votes, use_openmp)
*
* Majority-voting (MVIForest) tree walk: a tree votes a point anomalous
* when the point's path length in that tree is <= depth_cut -- the
* depth-domain image of the per-tree score cutoff (the Perl side
* precomputes depth_cut = -c(psi) * log2(threshold), so no per-tree
* exp()/log() runs in here).
*
* min_votes == 0: sm[i] = the point's full vote count over all n_trees
* trees (a small integer stored as a double, so the existing
* finalize_* helpers work on the buffer unchanged).
* min_votes > 0: sm[i] = 1.0/0.0 anomaly label, with per-point early
* exit: the walk stops as soon as the point has min_votes votes (the
* remaining trees can't change the outcome) or can no longer reach
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
AvARRAY(av)[1] = newRV_noinc((SV*)iav);
AvARRAY(av)[2] = newRV_noinc((SV*)cav);
AvARRAY(av)[3] = newSVnv(b);
AvARRAY(av)[4] = left;
AvARRAY(av)[5] = right;
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;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# -ffp-contract=off rides along with any -march: once the target
# has FMA (x86-64-v3, most -march=native hosts), the compiler may
# otherwise contract a*b+c expressions into fused multiply-adds
# whose different rounding breaks the documented guarantee that
# use_c => 1 and use_c => 0 build bit-identical trees (one ulp in a
# split value cascades into a structurally different tree). The
# -march speedup comes from AVX2 vectorization, not contraction,
# so this costs little (verified against the fit-determinism and
# scoring-parity tests).
my $opt_level = $opt;
$opt_level .= " -march=$arch -ffp-contract=off" if length $arch;
# IF_NO_OPENMP=1 forces the serial C build: the OpenMP compile attempt
# 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 )
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
learned as they arrive and forgotten once they age out of a sliding
window. Models saved by either class can be loaded through L<load|/load($path)>,
which dispatches on the stored format tag.
Throughout these docs, B<psi> is the paper's ψ: the number of points each
tree is built from, which C<sample_size> sets and which other
implementations often call I<max samples>. See L</REFERENCES>.
=head1 NATIVE ACCELERATION (Inline::C and OpenMP)
Both the scoring hot path (C<score_samples>, C<predict>, C<path_lengths>,
C<score_predict_samples>, and C<score_predict_split>) and the C<fit()>
tree builder are automatically accelerated through
L<Inline::C> when it is installed and a working C compiler is reachable.
If the toolchain also accepts C<-fopenmp> and can link against
C<libgomp>, the per-point tree walk runs in parallel across all
available CPU cores using OpenMP, and the extended-mode oblique dot
product is vectorised via C<#pragma omp simd> -- which on modern x86
compilers translates to an unrolled FMA / AVX gather chain that's
substantially faster for high-feature-count extended models.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
- impute_with :: 'mean' or 'median'; the statistic used to compute the
per-feature fill under missing => 'impute'. Ignored otherwise.
default :: mean
- voting :: how the per-tree results are aggregated at scoring time.
Trees are built identically in both settings -- only aggregation
changes -- so the knob composes with either mode (axis or
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
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $missing = $args{missing} // 'die';
croak "missing must be one of: die, zero, impute, nan"
unless $missing =~ /\A(?:die|zero|impute|nan)\z/;
my $impute_with = $args{impute_with} // 'mean';
croak "impute_with must be 'mean' or 'median'"
unless $impute_with =~ /\A(?:mean|median)\z/;
# How per-tree results are aggregated at scoring time. Trees are
# built identically either way -- this knob never touches fit()'s
# forest, only how score/predict combine the per-tree path lengths.
# mean :: classic IForest: average path length across trees,
# normalised into one score (the default)
# majority :: MVIForest (Chabchoub et al. 2022): each tree votes
# anomalous/normal against the decision threshold and
# the label is the majority of the tree votes
my $voting = $args{voting} // 'mean';
croak "voting must be 'mean' or 'majority'"
unless $voting =~ /\A(?:mean|majority)\z/;
if ( defined( $args{seed} ) ) {
$args{seed} = abs( int( $args{seed} ) );
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
seed => 42,
);
$iforest->fit_from_csv('huge.csv', header => 1);
=cut
sub fit_from_csv {
my ( $self, $path, %opt ) = @_;
croak "fit_from_csv() requires a path to a CSV file"
unless defined $path && length $path;
croak "fit_from_csv(): '$path' is not a readable file"
unless -f $path && -r _;
croak "fit_from_csv() does not support munger models; " . "load the data through fit_tagged/fit instead"
if _plan($self);
# Decide once whether the first line is a header, so every pass skips the
# same line and row indices stay aligned. header => 1 forces it; otherwise
# a first line carrying any non-numeric text (or matching stored
# feature_names) is a header -- data rows hold only numbers and blanks.
my $skip_first = $self->_detect_header( $path, $opt{header} );
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
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)
Returns an arrayref of the mean isolation depth per sample, for inspection.
my $lengths = $forest->path_lengths(\@data);
print "x, y, length\n";
my $int=0;
while (defined($data[$int])) {
print $data[$int][0].', '.$data[$int][1].', '.$lengths->[$int]."\n";
$int++;
}
=cut
sub path_lengths {
my ( $self, $data ) = @_;
$self->_check_fitted;
my $trees = $self->{trees};
my $t = scalar @$trees;
if ( $self->{_use_c} && $self->{_c_nodes} ) {
my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
my $sums_packed = "\0" x ( $n_pts * 8 );
score_all_xs(
$self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
$x_packed, $sums_packed, $n_pts,
$nf, $t, $self->{_use_openmp}
);
my $result = [];
finalize_path_lengths_xs( $sums_packed, $n_pts, $t + 0.0, $result );
return $result;
} ## end if ( $self->{_use_c} && $self->{_c_nodes} )
$data = $self->_prepare_perl_input($data);
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
# Pure-Perl fallback (tree-outer, sample-inner for cache locality).
my @sums = (0) x @$data;
for my $tree (@$trees) {
for my $i ( 0 .. $#$data ) {
$sums[$i] += _path_length( $data->[$i], $tree, 0, $nan );
}
}
return [ map { $_ / $t } @sums ];
} ## end sub path_lengths
=head2 predict(\@data, $threshold)
Returns an arrayref of 0/1 labels for the specified data.
If threshold is not specified it uses the contamination-learned cutoff (if
C<fit> was called with C<contamination>), otherwise 0.5.
Under C<< voting => 'majority' >> the threshold is the per-tree score
cutoff each tree votes against, and a sample is labelled 1 when more than
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
return $result;
}
my $rows = $self->_prepare_perl_input($data);
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
my @labels;
for my $x (@$rows) {
my $votes = 0;
my $label = 0;
for my $ti ( 0 .. $t - 1 ) {
if ( _path_length( $x, $trees->[$ti], 0, $nan ) <= $cut ) {
$votes++;
if ( $votes >= $maj ) { $label = 1; last }
}
last if $votes + ( $t - 1 - $ti ) < $maj;
}
push @labels, $label;
} ## end for my $x (@$rows)
return \@labels;
} ## end if ( $self->{voting} eq 'majority' )
# Fast path: threshold the raw path-length sums directly, skipping the
# per-point exp() and the intermediate scores arrayref.
# Derivation: score = exp(-sum * log(2) / (c*t))
# so score >= T iff sum <= -log(T) * c * t / log(2)
# Only valid for a normal threshold in (0, 1) and a positive c.
if ( $self->{_use_c}
&& $self->{_c_nodes}
&& $self->{c_psi} > 0
&& $threshold > 0
&& $threshold < 1 )
{
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $theta = defined $self->{threshold} ? $self->{threshold} : 0.5;
my $cut = _depth_cut( $theta, $c );
if ( $self->{_use_c} && $self->{_c_nodes} ) {
my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
my $votes_packed = "\0" x ( $n_pts * 8 );
vote_all_xs( $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
$x_packed, $votes_packed, $n_pts, $nf, $t, $cut, 0, $self->{_use_openmp} );
# votes/t is exactly the "divide the sum buffer by t" shape
# finalize_path_lengths_xs implements, so reuse it.
my $result = [];
finalize_path_lengths_xs( $votes_packed, $n_pts, $t + 0.0, $result );
return $result;
} ## end if ( $self->{_use_c} && $self->{_c_nodes} )
my $votes = $self->_vote_counts_perl( $self->_prepare_perl_input($data), $cut );
return [ map { $_ / $t } @$votes ] if _NV_IS_DOUBLE;
# Wide-NV perls: the C finalizers divide in double, so narrow the
# vote fraction to match -- see _NV_IS_DOUBLE.
return [ map { _to_double( $_ / $t ) } @$votes ];
} ## end if ( $self->{voting} eq 'majority' )
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
return [ (0.5) x $n_pts ];
} ## end if ( $self->{_use_c} && $self->{_c_nodes} )
$data = $self->_prepare_perl_input($data);
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
# Pure-Perl fallback (tree-outer, sample-inner for cache locality).
my @sums = (0) x @$data;
for my $tree (@$trees) {
for my $i ( 0 .. $#$data ) {
$sums[$i] += _path_length( $data->[$i], $tree, 0, $nan );
}
}
# Precompute the single normalising factor; exp() is a direct FPU
# instruction and faster than Perl's general-purpose 2**x (pow).
# Derivation: 2**(-avg/c) = 2**(-(sum/t)/c) = exp(-sum * log(2)/(c*t))
if ( $c > 0 ) {
my $inv = log(2) / ( $c * $t );
return [ map { exp( -$_ * $inv ) } @sums ];
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
normalised. Features whose substitution does not
de-anomalise the sample get 0. Each feature entry
additionally carries C<delta> (may be negative:
substituting a correlated feature can make the sample MORE
anomalous) and C<baseline> (the value swapped in). Costs
n_samples * (n_features + 1) rows through the ordinary
scorer -- C-accelerated when available.
path :: split attribution (local DIFFI; Carletti, Terzi &
Susto -- see REFERENCES). The sample walks every tree;
each split node crossed credits its feature(s) with
1/h_t - 1/h_max, where h_t is that tree's path length for
the sample and h_max the longest across the forest -- so
the trees that isolated the sample quickly speak loudest
and trees that treated it as normal say nothing. An
oblique (extended-mode) split spreads its credit across
its features in proportion to |coefficient * value|.
Needs nothing stored beyond the trees (so it works on
models saved before baseline support) and runs pure Perl
over the tree walks.
Why ablation is the default: it directly answers "would this sample
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
=item * Loading a model that carries mungers does not require
Algorithm::ToNumberMunger -- inspection and positional scoring work
without it; the first tagged call croaks with an install hint. A
munger name unknown to an older installed Algorithm::ToNumberMunger
croaks naming it; the model records C<munger_module_version> (the
version that authored the spec) to make that diagnosable.
=item * Munging happens before the C<missing> strategy: for munged
columns the strategy sees the munger's output, and most mungers define
their own undef handling (C<length> counts undef as 0, C<enum> takes a
C<default>, ...). Raw columns behave exactly as without mungers.
=item * Caveats inherited from the munger set: the C<eps> munger talks
to an external service, so a saved model using it needs that service
reachable wherever the model runs; C<frozen_freq_map>/C<ngram> count
tables are part of the spec and therefore of the model file.
=back
The munger spec composes with everything else -- modes, voting,
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
C<--prototype> on C<iforest fit> / C<iforest stream> -- stamps the
schema metadata into the model JSON, so every downstream consumer
(C<iforest info>, resumed streams, your own tooling) can tell which
revision of the input schema a model was built against.
{
"format": "Algorithm::Classifier::IsolationForest::Prototype",
"version": 1,
"class": "online",
"schema_version": "2026.07.08-1",
"schema_description": "HTTP request stream: method enum, path length, host entropy, raw byte count",
"schema": {
"feature_names": ["method", "path_len", "host_entropy", "bytes"],
"feature_descriptions": {
"method": "HTTP request method, mapped via http_method_enum (-1 = unknown)",
"path_len": "character length of the request path",
"host_entropy": "Shannon entropy of the Host header",
"bytes": "raw response byte count, passed through unmunged"
},
"mungers": {
"method": { "munger": "http_method_enum", "default": -1 },
"path_len": { "munger": "length", "from": "path" },
"host_entropy": { "munger": "entropy", "from": "host" }
},
"missing": "zero"
},
"params": {
"n_trees": 150,
"window_size": 4096,
"max_leaf_samples": 32,
"contamination": 0.02
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
croak "prototype has unknown top-level key '$k'"
unless $k =~ /\A(?:format|version|class|schema_version|schema_description|schema|params)\z/;
}
my $which = $proto->{class};
croak "prototype needs a class of 'batch' or 'online'"
unless defined $which && !ref $which && $which =~ /\A(?:batch|online)\z/;
for my $req (qw(schema_version schema_description)) {
croak "prototype needs a non-empty $req string"
unless defined $proto->{$req} && !ref $proto->{$req} && length $proto->{$req};
}
my $schema = $proto->{schema};
croak "prototype needs a schema object" unless ref $schema eq 'HASH';
for my $k ( sort keys %$schema ) {
croak "prototype schema has unknown key '$k' for a $which prototype (allowed: "
. join( ', ', sort keys %{ $PROTO_SCHEMA_KEYS{$which} } ) . ')'
unless $PROTO_SCHEMA_KEYS{$which}{$k};
}
my $tags = $schema->{feature_names};
croak "prototype schema needs a non-empty feature_names array"
unless ref $tags eq 'ARRAY' && @$tags;
for my $t (@$tags) {
croak "prototype feature_names entries must be non-empty strings"
unless defined $t && !ref $t && length $t;
}
_validate_feature_descriptions( $tags, $schema->{feature_descriptions} )
if defined $schema->{feature_descriptions};
croak "prototype schema mungers must be an object of 'tag => munger spec'"
if defined $schema->{mungers} && ref $schema->{mungers} ne 'HASH';
for my $str (qw(missing impute_with)) {
croak "prototype schema $str must be a plain string"
if defined $schema->{$str} && ref $schema->{$str};
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
=cut
###
###
### internal stuff below
###
###
#-------------------------------------------------------------------------------
# c(n): the expected path length of an unsuccessful search in a binary search
# tree of n nodes. Isolation Forest uses it (a) to adjust the path length when a
# leaf still holds more than one point (depth limit reached), and (b) to
# normalise the average path length into a 0..1 anomaly score.
#
# Args:
# $n :: a point count, non-negative integer. Either a leaf's size or the
# per-tree sub-sample size psi.
#
# Returns: the expected path length, a float. 0.0 for n <= 1 (nothing is
# left to search) and 1.0 for n == 2, both special-cased because the
# harmonic approximation is only accurate for larger n.
#
# Example:
# _c(1); # 0.0
# _c(256); # ~10.24 -- the normaliser for a default sample_size fit
#-------------------------------------------------------------------------------
sub _c {
my ($n) = @_;
return 0.0 if $n <= 1;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $harmonic = log( $n - 1 ) + EULER; # H(n-1) ~= ln(n-1) + gamma
return 2.0 * $harmonic - ( 2.0 * ( $n - 1 ) / $n );
}
#-------------------------------------------------------------------------------
# Majority-voting (voting => 'majority') helpers. MVIForest -- Chabchoub,
# Togbe, Boly & Chiky 2022 (see REFERENCES) -- has each tree vote a point
# anomalous when the tree's own score 2**(-h/c(psi)) clears the decision
# threshold, and takes the majority of the votes as the label. Trees are
# untouched; only these scoring-time aggregation helpers differ from the
# classic mean-path-length pipeline.
#-------------------------------------------------------------------------------
# Depth-domain image of the per-tree score cutoff: a tree votes a point
# anomalous when 2**(-h/c) >= theta, i.e. h <= -c * log2(theta). Doing the
# log once here keeps exp/log out of the per-point per-tree loops (both C
# and Perl compare raw path lengths against this cut). Degenerate inputs
# pin the cut so `h <= cut` still behaves: theta <= 0 is cleared by every
# per-tree score (all in (0, 1]), so +inf lets every tree vote; c <= 0 only
# happens for psi <= 1 forests, whose score convention is a flat 0.5 (see
# score_samples), so all trees vote iff theta is at or below that pivot.
#
# Args:
# $theta :: the per-tree score cutoff, normally in (0, 1]. Degenerate
# values are handled rather than rejected.
# $c :: c(psi) for this forest, i.e. $self->{c_psi}. Only <= 0 for a
# psi <= 1 forest.
#
# Returns: the path length at or below which a tree votes anomalous, a
# float. +inf when every tree should vote, -1.0 when none should.
#
# Example:
# _depth_cut( 0.6, 10.24 ); # ~7.55: isolate in <= 7.55 edges and vote
sub _depth_cut {
my ( $theta, $c ) = @_;
return ( $theta <= 0.5 ? 9**9**9 : -1.0 ) if $c <= 0;
return 9**9**9 if $theta <= 0;
return -$c * log($theta) / log(2);
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
#-------------------------------------------------------------------------------
# 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.
#
# Args:
# $desc :: arrayref of the per-point statistic sorted DESCENDING -- the
# mean-mode anomaly scores, or the majority pivots under
# voting => 'majority'. Must be non-empty.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# 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.
#
# Args:
# $data :: arrayref of rows already through _prepare_perl_input -- dense
# under impute, raw undef preserved under nan.
# $cut :: the depth cut from _depth_cut.
#
# Returns: arrayref of per-point vote counts, integers in [0, n_trees],
# positionally matching $data.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# Example:
# my $cut = _depth_cut( 0.6, $self->{c_psi} );
# my $votes = $self->_vote_counts_perl( $rows, $cut ); # [ 3, 97, 12, ... ]
sub _vote_counts_perl {
my ( $self, $data, $cut ) = @_;
my $trees = $self->{trees};
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
my @votes = (0) x @$data;
for my $tree (@$trees) {
for my $i ( 0 .. $#$data ) {
$votes[$i]++ if _path_length( $data->[$i], $tree, 0, $nan ) <= $cut;
}
}
return \@votes;
} ## end sub _vote_counts_perl
# 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
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$k = 1 if $k < 1;
$k = $n_pts if $k > $n_pts;
$self->{threshold} = _threshold_from_ranked( \@desc, $k );
return;
} ## end sub _learn_contamination_threshold
#-------------------------------------------------------------------------------
# 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.
#
# Args:
# $data :: arrayref of feature-value arrayrefs, raw or prepared -- it goes
# through _prepare_perl_input here either way.
#
# Returns: arrayref of per-point pivots, each a float in (0, 1],
# positionally matching $data.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $rows = $self->_prepare_perl_input($data);
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
# psi <= 1 degenerate forest: every per-tree score is pinned at 0.5
# (matching score_samples' convention), so every pivot is too.
return [ (0.5) x @$rows ] unless $c > 0;
my $inv = log(2) / $c;
my @pivots;
for my $x (@$rows) {
my @paths = sort { $a <=> $b } map { _path_length( $x, $_, 0, $nan ) } @$trees;
push @pivots, exp( -$paths[ $maj - 1 ] * $inv );
}
return \@pivots;
} ## end sub _majority_pivot_scores
# One draw from the standard normal N(0,1) via Box-Muller. Used to pick the
# random hyperplane orientations in Extended Isolation Forest mode.
#
# Args: none. Draws two uniforms from Perl's rand(), so the caller controls
# reproducibility through srand().
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
next if $line =~ /^\s*$/;
$first = $line;
last;
}
close $fh;
return 0 unless defined $first; # empty file; the census will report it
return 1 if $forced;
my @f = split /,/, $first, -1;
for my $x (@f) {
next if !length $x; # empty cell: fine in data
return 1 unless looks_like_number($x); # text: it is a header
}
# All-numeric first line: only a header if it reproduces feature_names.
my $names = $self->{feature_names};
if ( ref $names eq 'ARRAY' && @$names == @f ) {
my $match = grep { $f[$_] eq $names->[$_] } 0 .. $#f;
return 1 if $match == @f;
}
return 0;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $line_no = 0;
my $skipped = 0;
return sub {
while ( defined( my $line = <$fh> ) ) {
$line_no++;
$line =~ s/\r?\n\z//;
next if $line =~ /^\s*$/;
if ( $skip_first && !$skipped ) { $skipped = 1; next; }
my @fields = split /,/, $line, -1;
for my $f (@fields) {
if ( !length $f ) { $f = undef; next; }
next unless $parse;
croak "fit_from_csv(): line $line_no value '$f' is not a number"
unless looks_like_number($f);
$f += 0;
}
return ( \@fields, $line_no );
} ## end while ( defined( my $line = <$fh> ) )
close $fh;
return;
}; ## end sub
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
binmode $fh;
my @off;
my $store = $max_off > 0 ? 1 : 0;
my $cap = int( $max_off / 8 );
my $n = 0;
my $skipped = 0;
my $nf;
# Consider the line at ($$sref, $off .. $off+$len). To stay fast we avoid
# copying the line: a zero-length line is empty, and any line whose first
# byte is a digit/sign/dot (>= '!') is non-blank without further checks --
# only a line starting with whitespace (< '!') is materialised to apply the
# reader's /^\s*$/ blank test. $abs is its absolute byte offset.
my $feed = sub {
my ( $abs, $sref, $off, $len ) = @_;
return if $len == 0;
if ( substr( $$sref, $off, 1 ) lt '!' ) { # leading whitespace: maybe blank
return if substr( $$sref, $off, $len ) !~ /\S/;
}
if ( $skip_first && !$skipped ) { $skipped = 1; return; }
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
while ( ( $nl = index( $s, "\n", $p ) ) >= 0 ) {
my $len = $nl - $p;
$len-- if $len && substr( $s, $nl - 1, 1 ) eq "\r"; # exclude a CRLF's CR
$feed->( $file_pos + $p, \$s, $p, $len );
$p = $nl + 1;
}
$carry = substr( $s, $p );
$file_pos += $p;
} ## end while ( my $got = read( $fh, $buf, 1 << 20 ) )
close $fh;
$feed->( $file_pos, \$carry, 0, length $carry ) if length $carry; # final unterminated line
return ( $n, $nf, $store ? \@off : undef );
} ## end sub _index_pass
# Random-access gather: seek to each sampled row's recorded offset and numify
# it. Indices are visited in order for sequential-ish disk access.
#
# Args:
# $path :: path to the CSV file, which must be readable.
# $offsets :: the arrayref of per-row byte offsets from _index_pass.
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my %pool;
for my $i ( sort { $a <=> $b } keys %$want ) {
seek( $fh, $offsets->[$i], 0 )
or croak "fit_from_csv(): seek failed for row $i: $!";
my $line = <$fh>;
croak "fit_from_csv(): row $i is past the end of '$path'" unless defined $line;
$line =~ s/\r?\n\z//;
my @f = split /,/, $line, -1;
croak "fit_from_csv(): sampled row $i has " . scalar(@f) . " columns but expected $nf"
unless @f == $nf;
for my $x (@f) { $x = undef if !length $x }
$self->_numify_row( \@f, "sampled row $i" );
$pool{$i} = \@f;
} ## end for my $i ( sort { $a <=> $b } keys %$want )
close $fh;
return \%pool;
} ## end sub _gather_indexed
# Draw $k distinct indices uniformly from [0, $n) via Floyd's algorithm --
# O($k) time and memory, so it never allocates the 0..n-1 vector _subsample()
# builds (the whole point: n may not fit in RAM). Returns them sorted, which
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $dot = 0.0;
$dot += $coef[$_] * $row->[ $idx[$_] ] for 0 .. $#idx;
if ( $dot <= $b ) { push @left, $row }
else { push @right, $row }
}
}
return [ _NODE_OBLIQUE, \@idx, \@coef, $b, \@left, \@right ];
} ## end sub _oblique_split
#-------------------------------------------------------------------------------
# Path length of a single point in a single tree: edges traversed until a leaf,
# 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.
#-------------------------------------------------------------------------------
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
#
# Args:
# $x :: one sample, an arrayref of feature values. undef cells are
# allowed and handled per $nan.
# $node :: the node to start walking from, normally a tree root.
# $depth :: the depth credited to $node, 0 for a root. Callers only pass
# anything else to resume a partial walk.
# $nan :: true to use the nan-strategy routing described above; false or
# omitted to coerce undef to 0.
#
# Returns: the path length, a float -- edges walked plus c(leaf size), so
# it is not an integer whenever the walk ends in a multi-point leaf.
#
# Example:
# _path_length( [ 0.9, 0.4 ], $tree, 0, 0 ); # e.g. 3.51
sub _path_length {
my ( $x, $node, $depth, $nan ) = @_;
while ( $node->[0] ) { # false only for leaf (type 0)
if ( $node->[0] == _NODE_AXIS ) { # [1, attr, split, left, right]
if ($nan) {
my $v = $x->[ $node->[1] ];
$node = ( defined($v) && $v < $node->[2] ) ? $node->[3] : $node->[4];
} else {
$node = ( $x->[ $node->[1] ] // 0 ) < $node->[2] ? $node->[3] : $node->[4];
}
} else { # [2, \@idx, \@coef, b, left, right]
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$node = ( !$missing && $dot <= $b ) ? $node->[4] : $node->[5];
} else {
my $dot = 0.0;
$dot += $coef->[$_] * ( $x->[ $idx->[$_] ] // 0 ) for 0 .. $#$idx;
$node = $dot <= $b ? $node->[4] : $node->[5];
}
} ## end else [ if ( $node->[0] == _NODE_AXIS ) ]
$depth++;
} ## end while ( $node->[0] )
return $depth + _c( $node->[1] ); # leaf size at slot 1
} ## end sub _path_length
#-------------------------------------------------------------------------------
# Explanation (explain_samples) internals.
#-------------------------------------------------------------------------------
# Instrumented twin of _path_length: routes $x through one tree with
# EXACTLY _path_length's split logic while recording which feature(s)
# each crossed node tested. Returns (path_length, \@pairs) where
# path_length carries the usual c(leaf size) adjustment and each pair
# is [feature_index, share] -- an axis node contributes one pair with
# share 1, an oblique node one pair per participating feature with
# shares proportional to |coef_k * x_k| (each feature's part of the
# dot product), falling back to an even split when every term is 0.
#
# The caller (_explain_path) turns these walks into local-DIFFI credit
# (Carletti, Terzi & Susto, see REFERENCES): every node of a tree's
# walk is credited w_t = 1/h_t - 1/h_max, where h_t is this tree's
# (adjusted) path length and h_max the longest walk any tree gave the
# same sample -- so trees that isolated the sample quickly speak
# loudest, trees that treated it as normal say nothing, and the credit
# is a cross-TREE statistic. Within-tree positional weightings were
# tried and rejected: root-anchored credit (1/(depth+1)) mostly
# rediscovers the RNG (the root split's feature is drawn uniformly at
# random regardless of the sample), and leaf-anchored credit
# (1/(h-depth)) is diluted by the trees that never isolated the sample
# at all.
#
# Args:
# $x :: one sample, an arrayref of feature values. undef cells are
# allowed and handled per $nan.
# $node :: the node to start walking from, normally a tree root.
# $nan :: true to use the nan-strategy routing, matching _path_length.
#
# Returns: the two-element list ($path_length, $pairs). $path_length is
# the same float _path_length would return for this sample and tree.
# $pairs is an arrayref of [ feature_index, share ] entries, one per axis
# node crossed and one per participating feature at each oblique node, with
# the shares at any one node summing to 1.
#
# Example:
# my ( $h, $pairs ) = _path_length_explain( [ 0.9, 0.4 ], $tree, 0 );
# # ( 3.51, [ [ 1, 1 ], [ 0, 1 ], [ 1, 1 ] ] ) for an axis-mode tree
sub _path_length_explain {
my ( $x, $node, $nan ) = @_;
my $depth = 0;
my @pairs; # [feature, share] for every crossed node
while ( $node->[0] ) { # false only for leaf (type 0)
if ( $node->[0] == _NODE_AXIS ) { # [1, attr, split, left, right]
push @pairs, [ $node->[1], 1 ];
if ($nan) {
my $v = $x->[ $node->[1] ];
$node = ( defined($v) && $v < $node->[2] ) ? $node->[3] : $node->[4];
} else {
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
$node = ( !$missing && $dot <= $b ) ? $node->[4] : $node->[5];
} else {
my $dot = 0.0;
$dot += $coef->[$_] * ( $x->[ $idx->[$_] ] // 0 ) for 0 .. $#$idx;
$node = $dot <= $b ? $node->[4] : $node->[5];
}
} ## end else [ if ( $node->[0] == _NODE_AXIS ) ]
$depth++;
} ## end while ( $node->[0] )
return ( $depth + _c( $node->[1] ), \@pairs ); # leaf size at slot 1
} ## end sub _path_length_explain
# Turn one sample's per-tree walks into local-DIFFI feature credit --
# see _path_length_explain's comment for the weighting and what was
# tried instead. A plain function so the Online class can reuse it on
# its own walks.
#
# Args:
# $walks :: arrayref of one [ $path_length, $pairs ] per tree, exactly as
# _path_length_explain returns them. Trees that contributed no
# walk are simply absent.
# $nf :: the model's feature count, which fixes the returned width.
#
# Returns: arrayref of $nf raw credit totals, indexed by feature. These
# are unnormalised -- _credit_to_features turns them into shares. All
# zeroes when no tree isolated the sample faster than the slowest one.
#
# Example:
# my @walks = map { [ _path_length_explain( $x, $_, 0 ) ] } @$trees;
# my $credit = _walks_to_credit( \@walks, 2 ); # [ 0.51, 0.09 ]
sub _walks_to_credit {
my ( $walks, $nf ) = @_;
my $hmax = 0;
for (@$walks) { $hmax = $_->[0] if $_->[0] > $hmax }
my $credit = [ (0) x $nf ];
for my $walk (@$walks) {
my ( $h, $pairs ) = @$walk;
next unless @$pairs && $h > 0 && $hmax > 0;
my $w = 1.0 / $h - 1.0 / $hmax;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# features list explain_samples returns. Weights are the credit shares
# (summing to 1); a sample that never crossed a split node (all-leaf
# trees) carries no information, so every weight stays 0 rather than
# inventing a uniform split. A plain function, not a method: the
# Online class shapes its explanations through this too.
#
# Args:
# $names :: the model's feature_names arrayref, or undef when the model
# has none -- then every name comes back undef.
# $credit :: the raw per-feature credit from _walks_to_credit. Its
# length fixes how many features are reported.
# $row :: the sample being explained, an arrayref, so each feature can
# report the value it actually had.
#
# Returns: arrayref of hashrefs, one per feature, sorted by descending
# weight with the feature index breaking ties. Each holds index, name,
# weight (a share in [0, 1], summing to 1 unless every credit was 0) and
# value.
#
# Example:
# _credit_to_features( [ 'cpu', 'mem' ], [ 0.51, 0.09 ], [ 0.9, 0.4 ] );
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# Ablation counterpart of _credit_to_features: deltas are score drops
# (score(original) - score(feature substituted with its baseline));
# weight is each positive delta's share of the positive total, keeping
# weights in [0, 1] like the path method's. A negative delta -- the
# substitution made the sample MORE anomalous, possible with correlated
# features -- keeps its sign in delta but contributes weight 0.
#
# Args:
# $names :: the model's feature_names arrayref, or undef when the model
# has none -- then every name comes back undef.
# $deltas :: arrayref of per-feature score drops. Its length fixes how
# many features are reported.
# $row :: the sample being explained, an arrayref, so each feature can
# report the value it actually had.
# $baselines :: the per-feature substitution values the deltas were
# measured against, reported alongside them.
#
# Returns: arrayref of hashrefs, one per feature, sorted by descending
# weight with the feature index breaking ties. Each holds index, name,
# delta (signed), weight (a share in [0, 1]), value and baseline.
#
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my ( $self, $rows ) = @_;
my $scores = $self->score_samples($rows);
my $prepared = $self->_prepare_perl_input($rows);
my $nan = $self->{missing} eq 'nan' ? 1 : 0;
my $nf = $self->{n_features};
my $names = $self->{feature_names};
my $trees = $self->{trees};
my @out;
for my $i ( 0 .. $#$prepared ) {
my @walks = map { [ _path_length_explain( $prepared->[$i], $_, $nan ) ] } @$trees;
push @out,
{
score => $scores->[$i],
method => 'path',
features => _credit_to_features( $names, _walks_to_credit( \@walks, $nf ), $prepared->[$i] ),
};
}
return \@out;
} ## end sub _explain_path
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# the dense-pack opportunity described above; passing
# undef just skips that optimisation.
#
# Returns: the three-element list ($nodes_packed, $idx_packed,
# $val_packed) -- a 'd*' string of 6 doubles per node, an 'l*' string of
# int32 feature indices, and a 'd*' string of the matching coefficients.
# The latter two are empty strings for an axis-mode tree.
#
# Example:
# my ( $np, $ip, $vp ) = _pack_tree( $self->{trees}[0], $self->{n_features} );
# length($np) / ( 6 * 8 ); # node count
# ---------------------------------------------------------------------------
sub _pack_tree {
my ( $root, $n_features ) = @_;
if ( $HAS_C && _NV_IS_DOUBLE ) {
my ( $nodes_packed, $idx_packed, $val_packed ) = ( '', '', '' );
pack_tree_xs( $root, $n_features // -1, $nodes_packed, $idx_packed, $val_packed );
return ( $nodes_packed, $idx_packed, $val_packed );
}
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my ($node) = @_;
my $my_idx = scalar @node_data;
push @node_data, undef; # reserve slot; filled in after children
if ( $node->[0] == _NODE_LEAF ) {
# Slot 2 carries c(size) precomputed, so the C scoring loop
# adds it straight to the depth instead of paying a log()
# per point per tree at every leaf hit. _c is the same
# function the pure-Perl scorer uses, so both backends keep
# producing bit-identical path lengths.
$node_data[$my_idx] = [ 0.0, $node->[1] + 0.0, _c( $node->[1] ), 0.0, 0.0, 0.0 ];
} elsif ( $node->[0] == _NODE_AXIS ) {
my $li = $assign->( $node->[3] );
my $ri = $assign->( $node->[4] );
$node_data[$my_idx] = [
1.0,
$node->[1] + 0.0, # attr
$node->[2] + 0.0, # split
$li + 0.0,
$ri + 0.0,
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# $data :: either an arrayref of feature-value arrayrefs (returned
# unchanged, not copied) or a PackedData instance (unpacked into
# fresh rows).
#
# Returns: an arrayref of feature-value arrayrefs. Rows unpacked from
# PackedData hold plain doubles, so a NaN packed for a missing cell comes
# back as NaN rather than undef. Croaks on anything else.
#
# Example:
# my $rows = $self->_to_arrayref($data);
# _path_length( $rows->[0], $tree, 0, 0 );
sub _to_arrayref {
my ( $self, $data ) = @_;
return $data if ref $data eq 'ARRAY';
if ( ref $data eq 'Algorithm::Classifier::IsolationForest::PackedData' ) {
my $n_pts = $data->{n_pts};
my $nf = $data->{n_feats};
my @doubles = unpack( 'd*', $data->{packed} );
my @rows;
for my $i ( 0 .. $n_pts - 1 ) {
push @rows, [ @doubles[ $i * $nf .. ( $i + 1 ) * $nf - 1 ] ];
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# tree-building path -- _build_forest_c/_build_forest_openmp, and
# every parallel_fit worker, all of which go through pack_input_xs --
# already fills undef cells itself from this same fill vector, so
# skip the redundant whole-dataset copy when that's the path fit()
# will actually take. Scoring the training set for a learned
# contamination threshold (below, in fit()) is unaffected: it always
# runs through the pure-Perl scorer regardless of use_c (fit() drops
# any previous fit's packed buffers before that scoring, and
# _rebuild_c_trees runs after), and that path already tolerates raw
# undef cells
# for both zero (_path_length's "// 0") and impute (_prepare_perl_input
# densifies on demand from missing_fill).
my $fill
= $m eq 'impute'
? $self->_compute_impute_fill($data)
: [ (0) x $nf ];
$self->{missing_fill} = $fill if $m eq 'impute';
delete $self->{_fill_packed};
return $data if $self->{_use_c};
return _densify( $data, $fill );
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
} ## end for my $f ( 0 .. $nf - 1 )
return \@fallback;
} ## end sub _compute_feature_baselines
# Return a dense copy of $data with every undef cell replaced by the
# matching per-feature fill value. Leaves present cells untouched.
#
# Args:
# $data :: the rows to densify, an arrayref of feature-value arrayrefs.
# Never modified.
# $fill :: the per-feature fill values, an arrayref. Its length fixes
# the output width, so a row longer than $fill is truncated and
# a shorter one padded.
#
# Returns: a fresh arrayref of fresh rows -- nothing is shared with $data,
# so the caller may mutate either independently.
#
# Example:
# _densify( [ [ 0.9, undef ] ], [ 0, 0.5 ] ); # [ [ 0.9, 0.5 ] ]
sub _densify {
my ( $data, $fill ) = @_;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
my $fill = $self->{missing_fill};
croak "impute model is missing its fill vector"
unless ref $fill eq 'ARRAY' && @$fill == $self->{n_features};
$self->{_fill_packed} //= pack( 'd*', @$fill );
return ( 1, $self->{_fill_packed} );
}
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.
#
# Args:
# $data :: either an arrayref of feature-value arrayrefs or a PackedData
# instance -- _to_arrayref normalises it either way.
#
# Returns: an arrayref of rows ready for _path_length. Under impute these
# are a fresh dense copy; otherwise the rows are handed back as they came,
# so the caller must not mutate them. The nan flag is NOT part of this --
# callers pass it to _path_length themselves. Croaks when an impute model
# has lost its fill vector.
#
# Example:
# my $rows = $self->_prepare_perl_input($data);
# my $nan = $self->{missing} eq 'nan' ? 1 : 0;
# _path_length( $rows->[0], $tree, 0, $nan );
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/bench.pm view on Meta::CPAN
# Pre-pack once (when C is available) so the *_packed rows measure
# scoring in isolation, without the per-call pack_input_xs cost.
my $packed = $has_c ? $model->pack_data($data) : undef;
my @bench = (
[ 'score_samples' => sub { $model->score_samples($data) } ],
[ 'predict' => sub { $model->predict( $data, $thresh ) } ],
[ 'score_predict_samples' => sub { $model->score_predict_samples( $data, $thresh ) } ],
[ 'score_predict_split' => sub { my @r = $model->score_predict_split( $data, $thresh ); } ],
[ 'path_lengths' => sub { $model->path_lengths($data) } ],
);
if ( defined $packed ) {
push @bench,
(
[ 'score_samples (packed)' => sub { $model->score_samples($packed) } ],
[ 'predict (packed)' => sub { $model->predict( $packed, $thresh ) } ],
[ 'score_predict_split (packed)' => sub { my @r = $model->score_predict_split( $packed, $thresh ); } ],
);
}
lib/Algorithm/Classifier/IsolationForest/App/Command/pack.pm view on Meta::CPAN
# Args:
# $path :: path to the .iforest-packed file, which must be readable.
#
# Returns: the three-element list ($n_pts, $n_feats, $bytes) -- the row
# count, the feature width, and the raw row-major double buffer as a
# string. Dies with a message naming $path on a bad magic, an unsupported
# version, a non-zero reserved field, or a short read.
#
# Example:
# my ( $n_pts, $n_feats, $bytes ) = _read_packed('data.iforest-packed');
# length($bytes) == $n_pts * $n_feats * 8; # true
sub _read_packed {
my ($path) = @_;
open my $fh, '<:raw', $path or die "open '$path' for read: $!\n";
my $hdr;
read( $fh, $hdr, HEADER_LEN ) == HEADER_LEN
or die "'$path' is shorter than a packed-file header\n";
my ( $magic, $version, $reserved, $n_pts, $n_feats ) = unpack( 'a8 v v V V', $hdr );
die "'$path' does not look like a .iforest-packed file\n"
unless $magic eq MAGIC;
die "'$path' is .iforest-packed version $version; only " . VERSION . " is supported\n"
unless $version == VERSION;
die "'$path' has non-zero reserved field $reserved\n"
unless $reserved == 0;
my $bytes;
my $want = $n_pts * $n_feats * 8;
read( $fh, $bytes, $want ) == $want
or die "'$path' truncated: wanted $want bytes, got " . ( defined $bytes ? length($bytes) : 0 ) . "\n";
close $fh;
return ( $n_pts, $n_feats, $bytes );
} ## end sub _read_packed
# Write a .iforest-packed file: the header above followed by the buffer.
# The write is atomic, so a consumer never sees a half-written file even
# if the pack is interrupted.
#
# Args:
# $path :: where to write. An existing file is replaced.
lib/Algorithm/Classifier/IsolationForest/App/Command/stream.pm view on Meta::CPAN
# Refresh the contamination threshold against the post-stream window so
# the saved model's default cutoff tracks the stream.
if ( !$opt->{'score_only'} && defined $oif->{contamination} && $oif->window_count ) {
$oif->relearn_threshold;
}
if ( $opt->{'save'} && !$opt->{'score_only'} ) {
$oif->save( $opt->{'m'} );
}
if ( length $results_string ) {
if ( !defined( $opt->{'o'} ) ) {
print $results_string;
} else {
write_file( $opt->{'o'}, { 'atomic' => 1 }, $results_string );
}
}
return 1;
} ## end sub execute
lib/Algorithm/Classifier/IsolationForest/App/Command/streamc.pm view on Meta::CPAN
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
. '", is '
. length($socket)
. ' bytes; Unix socket paths are limited to ~104 bytes -- use a shorter path'
. "\n" )
if length($socket) > 100;
$SOCK = IO::Socket::UNIX->new( Peer => $socket )
or die( 'failed to connect to "'
. $socket . '": '
. $!
. ' -- is streamd running'
. ( defined $opt->{'set'} ? ' with --set ' . $opt->{'set'} : '' ) . '?'
. "\n" );
$SOCK->autoflush(1);
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
The array row form is positional (scalar mungers applied, like stream
CSV input); the object form is a tagged row and runs the full munger
plan, including expanding and combining mungers -- and, being JSON, the
raw values may safely contain commas, newlines, or any unicode.
A worked tagged example. Create the daemon around raw HTTP request
data, with mungers turning the raw values into numbers (mungers.json
here; a --prototype carrying the same schema works identically):
{ "method": { "munger": "http_method_enum", "default": -1 },
"path_len": { "munger": "length", "from": "path" },
"host_entropy": { "munger": "entropy", "from": "host" } }
iforest streamd --set web -t method -t path_len -t host_entropy \
--mungers mungers.json -c 0.05
Clients then send the raw values themselves -- note the input fields
are the munger SOURCES (method, path, host), not the feature tags,
because the plan derives path_len and host_entropy from them:
-> {"row": {"method": "GET", "path": "/index.html",
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
$OPT{$path_opt} = File::Spec->rel2abs( $OPT{$path_opt} )
if defined $OPT{$path_opt};
}
# sun_path is 104 bytes on the BSDs and 108 on Linux (including the
# NUL); Socket.pm just warns and TRUNCATES an over-long path, which
# binds a socket nobody will ever find. Refuse loudly instead.
die( '--socket, "'
. $OPT{'socket'}
. '", is '
. length( $OPT{'socket'} )
. ' bytes; Unix socket paths are limited to ~104 bytes -- use a shorter path'
. "\n" )
if length( $OPT{'socket'} ) > 100;
# --- directories, before anything forks or binds -----------------------
_ensure_dir( $OPT{'model_dir'}, '--model-dir' );
_ensure_dir( dirname( $OPT{'socket'} ), '--socket' );
_ensure_dir( dirname( $OPT{'pid'} ), '--pid' );
# --- refuse to double-start ---------------------------------------------
if ( -e $OPT{'socket'} ) {
my $probe = IO::Socket::UNIX->new( Peer => $OPT{'socket'} );
die( 'another daemon is already listening on "' . $OPT{'socket'} . '"' . "\n" ) if $probe;
lib/Algorithm/Classifier/IsolationForest/App/Command/streamd.pm view on Meta::CPAN
my $c = $CONN{ fileno($s) } or return;
my $got = sysread( $s, my $chunk, 65536 );
if ( !defined $got ) {
return if $!{EAGAIN} || $!{EWOULDBLOCK} || $!{EINTR};
return _drop( $s, $rsel, $wsel );
}
return _drop( $s, $rsel, $wsel ) if $got == 0; # client closed
$c->{inbuf} .= $chunk;
if ( length( $c->{inbuf} ) > MAX_INBUF && $c->{inbuf} !~ /\n/ ) {
_log( 'dropping client: unterminated line exceeded ' . MAX_INBUF . ' bytes' );
return _drop( $s, $rsel, $wsel );
}
while ( $c->{inbuf} =~ s/\A([^\n]*)\n// ) {
my $line = $1;
next if $line =~ /\A\s*\z/;
_handle_line( $c, $line );
return _drop( $s, $rsel, $wsel ) if length( $c->{outbuf} ) > MAX_OUTBUF;
}
_flush( $s, $rsel, $wsel ) if length $c->{outbuf};
return 1;
} ## end sub _read_from
# Push as much of a connection's pending output as the socket will take.
# A client that cannot keep up leaves the remainder buffered and the
# socket registered for write-readiness, so the daemon never blocks on a
# slow reader.
#
# Args:
# $s :: the client socket.
# $rsel :: the read IO::Select set, needed only to hand to _drop.
# $wsel :: the write IO::Select set. $s is added while output remains
# and removed once it has all gone out.
#
# Returns: 1 when the buffer drained completely, the result of _drop on a
# write error, or an empty return when the socket would block with output
# still pending.
#
# Example:
# _flush( $s, $rsel, $wsel ) if length $c->{outbuf};
sub _flush {
my ( $s, $rsel, $wsel ) = @_;
my $c = $CONN{ fileno($s) } or return;
while ( length $c->{outbuf} ) {
my $wrote = syswrite( $s, $c->{outbuf} );
if ( !defined $wrote ) {
if ( $!{EAGAIN} || $!{EWOULDBLOCK} || $!{EINTR} ) {
$wsel->add($s) unless $wsel->exists($s);
return;
}
return _drop( $s, $rsel, $wsel );
}
substr( $c->{outbuf}, 0, $wrote, '' );
} ## end while ( length $c->{outbuf} )
$wsel->remove($s) if $wsel->exists($s);
return 1;
} ## end sub _flush
#-------------------------------------------------------------------------------
# protocol
#-------------------------------------------------------------------------------
# One request line -> one reply line, appended to the connection's
# output buffer. Any croak from the model becomes an {"error": ...}
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
generator in the same order as the pure-Perl path -- so, like the
parent's C<fit()>, a C<learn()> with a given seed produces bit-identical
trees whether C<use_c> is on or off (on C<nvsize == 8> perls; wide-NV
perls keep extra low bits in the pure-Perl path). The knob changes
speed, never results.
Batch scoring lazily flattens the mutable trees into the same packed
node layout the batch scorer walks -- online trees are axis-only, and
the online per-leaf depth adjustment rides in the slot the batch packer
uses for its own leaf adjustment -- so C<score_samples>, C<predict>,
C<path_lengths>, C<score_predict_samples>, and C<score_predict_split>
all run through the same C (and OpenMP, when linked) tree walk the
parent uses, with identical results to the pure-Perl fallback. Any
C<learn> invalidates the packed snapshot; the next batch-scoring call
repacks once. C<score_learn> never touches the snapshot: it mutates
the trees after every single point, so its rows are scored by walking
the live trees in C instead.
A model needs to have seen at least C<max_leaf_samples> points before
tree structure exists at all; until then every point scores 1.0. Give
the model a warm-up C<learn()> pass before trusting scores or labels.
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
Croaks under the same conditions as L<tagged_row_to_array|/tagged_row_to_array(\%row, $caller)>.
=cut
sub explain_sample_tagged {
my ( $self, $row, %opts ) = @_;
my $vec = $self->tagged_row_to_array( $row, 'explain_sample_tagged' );
return $self->explain_samples( [$vec], %opts )->[0];
}
=head2 path_lengths(\@data)
Returns an arrayref of the mean isolation depth per sample across the
trees, for inspection -- the streaming counterpart of the parent class's
method of the same name. Depths include the per-leaf count adjustment.
my $depths = $oif->path_lengths(\@data);
=cut
sub path_lengths {
my ( $self, $data ) = @_;
$self->_check_learned;
croak "path_lengths() expects an arrayref of samples"
unless ref $data eq 'ARRAY';
my $t = scalar @{ $self->{trees} };
if ( $self->_ensure_c_trees ) {
my ( $n_pts, $x_packed ) = $self->_pack_input($data);
my $sums_packed = "\0" x ( $n_pts * 8 );
Algorithm::Classifier::IsolationForest::score_all_xs(
$self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
$x_packed, $sums_packed, $n_pts,
$self->{n_features}, $t, $self->{_use_openmp}
);
my $result = [];
Algorithm::Classifier::IsolationForest::finalize_path_lengths_xs( $sums_packed, $n_pts, $t + 0.0, $result );
return $result;
} ## end if ( $self->_ensure_c_trees )
my $sums = $self->_depth_sums($data);
return [ map { $_ / $t } @$sums ];
} ## end sub path_lengths
=head2 predict(\@data, $threshold)
Returns an arrayref of 0/1 labels for the specified data, without
learning it.
If C<$threshold> is not given, the contamination-learned cutoff is used
when available (learned from the current window on first use -- see
C<contamination> in L<new|/new(%args)>), otherwise 0.5.
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
return [ map { $_ // 0 } @$row ];
} ## end sub _prep_row
# The depth budget for n points: how deep a tree fed n points is allowed
# (learn) or expected (scoring normalisation, per-leaf adjustment) to
# go. log base 4 = log(2 * branching_factor) with binary trees. Under
# max_leaf_samples points there is nothing to isolate: 0.
#
# Args:
# $n :: a point count, non-negative. A tree's count when budgeting its
# depth, a leaf's count when adjusting a path length.
#
# Returns: the depth budget as a float, 0 for n below max_leaf_samples and
# growing logarithmically past it.
#
# Example:
# $self->_rpl(32); # 0 at the default max_leaf_samples of 32
# $self->_rpl(2048); # ~3.0
sub _rpl {
my ( $self, $n ) = @_;
my $eta = $self->{max_leaf_samples};
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
my ( $self, $depth ) = @_;
return $self->{max_leaf_samples} * ( $self->{growth} eq 'adaptive' ? 2**$depth : 1 );
}
# Number of points the model currently reflects: the window fill, or the
# whole stream when forgetting is disabled. This is the population the
# score normaliser is computed against, so it moves as the stream does.
#
# Args: none beyond the model itself.
#
# Returns: the point count as an integer -- the retained window's length,
# or the lifetime seen count under window_size 0.
#
# Example:
# $self->_data_size; # 2048 once a default window has filled
sub _data_size {
my ($self) = @_;
return $self->{window_size} ? scalar @{ $self->{window} } : $self->{seen};
}
# exp() multiplier turning a per-sample depth SUM into the normalised
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
# Depth of the leaf $x lands in, plus the leaf's own depth budget -- the
# streaming analogue of the batch scorer's c(leaf size) adjustment.
# Scoring tolerates undef cells (mapped to 0), matching the parent class.
#
# Args:
# $x :: one sample, an arrayref of feature values. undef cells are
# allowed and count as 0.
# $node :: the node to start walking from, normally a tree's root. Must
# be defined -- callers skip trees that have not grown one.
#
# Returns: the path length as a float: edges walked plus the leaf's
# _rpl(count), so it is rarely a whole number.
#
# Example:
# $self->_depth_of( [ 0.9, 0.4 ], $self->{trees}[0]{root} ); # e.g. 2.8
sub _depth_of {
my ( $self, $x, $node ) = @_;
my $depth = 0;
while ( $node->[_N_TYPE] ) {
$node = ( $x->[ $node->[_N_ATTR] ] // 0 ) < $node->[_N_SPLIT] ? $node->[_N_LEFT] : $node->[_N_RIGHT];
$depth++;
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
} ## end sub _score_row
#-------------------------------------------------------------------------------
# Explanation (explain_samples) internals. The output shaping is shared
# with the parent class (_credit_to_features / _deltas_to_features) so
# both classes return the identical structure; only the walks and the
# baseline source differ.
#-------------------------------------------------------------------------------
# Path-credit explanation: _depth_of's exact routing recorded as
# (path length, crossed features) walks, turned into local-DIFFI
# credit by the parent's _walks_to_credit (see _path_length_explain
# there for the weighting and its rationale). Path lengths carry the
# per-leaf _rpl(count) adjustment, exactly as scoring's do -- with the
# shallow trees online models build, most of the between-tree contrast
# lives in that adjustment, not the raw depth. Online trees are
# axis-only, so each node credits exactly one feature (share 1).
#
# Args:
# $data :: the samples to explain, an arrayref of feature-value
# arrayrefs, already prepped by the caller.
#
# Returns: arrayref of one hashref per row, in input order, each holding
lib/Algorithm/Classifier/IsolationForest/Online.pm view on Meta::CPAN
# Args:
# $root :: the tree's root node, or undef for a tree that has not learned
# anything yet.
#
# Returns: a packed 'd*' string of 6 doubles per node, in the parent's node
# layout. An undef root yields the single zeroed leaf record described
# above, which walks as depth 0 with no adjustment.
#
# Example:
# my $buf = $self->_pack_online_tree( $tree->{root} );
# length($buf) / ( 6 * 8 ); # node count
sub _pack_online_tree {
my ( $self, $root ) = @_;
# A tree that has not learned anything walks as depth 0 with a zero
# adjustment: one empty leaf record.
return pack( 'd*', 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) unless defined $root;
my @node_data;
my $assign;
$assign = sub {
t/02-accel-selection.t view on Meta::CPAN
n_trees => 30,
sample_size => 40,
seed => 17,
use_c => 0,
);
$fc->fit( \@data );
$fp->fit( \@data );
my $sc = $fc->score_samples( \@data );
my $sp = $fp->score_samples( \@data );
is( scalar @$sc, scalar @$sp, 'same length' );
my $max_diff = 0;
for my $i ( 0 .. $#$sc ) {
my $d = abs( $sc->[$i] - $sp->[$i] );
$max_diff = $d if $d > $max_diff;
}
cmp_ok( $max_diff, '<', 1e-9, "C and Perl scores agree (max diff $max_diff)" );
# Labels at the default cutoff must match exactly.
my $lc = $fc->predict( \@data );
t/04-accel-tuning.t view on Meta::CPAN
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 {
t/10-constructor.t view on Meta::CPAN
return $ok ? undef : ( $@ // 'died' );
}
my $CLASS = 'Algorithm::Classifier::IsolationForest';
subtest 'basic construction' => sub {
my $f = $CLASS->new;
isa_ok( $f, $CLASS, 'new() with no args returns an object' );
can_ok(
$f,
qw(new fit score_samples predict path_lengths decision_threshold
to_json from_json save load)
);
};
subtest 'defaults' => sub {
my $f = $CLASS->new;
is( $f->{n_trees}, 100, 'n_trees defaults to 100' );
is( $f->{sample_size}, 256, 'sample_size defaults to 256' );
is( $f->{mode}, 'axis', 'mode defaults to axis' );
is( $f->{max_depth}, undef, 'max_depth defaults to undef (auto)' );
use_c => $USE_C
);
$f->fit( \@data );
is( scalar @{ $f->{trees} }, 7, 'builds exactly n_trees trees' );
is( $f->{n_features}, 2, 'n_features inferred from the data' );
is( $f->{psi_used}, scalar @data,
'sub-sample size is clamped to the data size when sample_size is larger' );
}; ## end "[$be_name] fit() records training metadata" => sub
subtest "[$be_name] consumers croak before fit()" => sub {
for my $method (qw(score_samples predict path_lengths to_json)) {
my $f = $CLASS->new( use_c => $USE_C );
like( exception { $f->$method( \@data ) }, qr/not fitted/i, "$method() croaks on an unfitted model" );
}
};
} ## end for my $be (@BACKENDS)
done_testing;
t/30-scoring.t view on Meta::CPAN
subtest "[$be_name] score_samples shape and range" => sub {
my $scores = $f->score_samples( \@data );
is( ref $scores, 'ARRAY', 'score_samples returns an arrayref' );
is( scalar @$scores, scalar @data, 'one score per input sample' );
my $bad = grep { !defined $_ || $_ <= 0 || $_ > 1 } @$scores;
is( $bad, 0, 'every anomaly score lies in (0, 1]' );
};
subtest "[$be_name] path_lengths shape and range" => sub {
my $lengths = $f->path_lengths( \@data );
is( ref $lengths, 'ARRAY', 'path_lengths returns an arrayref' );
is( scalar @$lengths, scalar @data, 'one mean path length per sample' );
my $bad = grep { !defined $_ || $_ < 0 } @$lengths;
is( $bad, 0, 'every mean path length is non-negative' );
};
subtest "[$be_name] scoring an arbitrary query set" => sub {
my @query = ( [ 2, 2 ], [ 100, 100 ] ); # one in-range, one far out
my $scores = $f->score_samples( \@query );
is( scalar @$scores, 2, 'scores returned for an out-of-training query set' );
cmp_ok( $scores->[1], '>', $scores->[0], 'a point far outside the data scores higher than one inside it' );
};
subtest "[$be_name] predict returns 0/1 labels, one per sample" => sub {
t/31-undef-column-no-warnings.t view on Meta::CPAN
#!perl
# 31-undef-column-no-warnings.t
#
# Verifies that score_samples, predict, and score_predict_samples produce
# no warnings when a sample contains undef in one or more feature columns.
#
# Perl coerces undef to 0 in numeric context. The _path_length traversal
# guards every feature access with "// 0" so that the coercion is silent
# regardless of which column(s) are undef. The same battery runs against
# the pure-Perl backend and, when it compiled, the C backend; a missing C
# backend skips that arm rather than failing.
use strict;
use warnings;
use Test::More;
use Algorithm::Classifier::IsolationForest;
t/31-undef-column-no-warnings.t view on Meta::CPAN
subtest "[$be_name] score_predict_split emits no warnings with undef column(s)" => sub {
my @warns = _capture_warnings( sub { $f->score_predict_split( \@undef_pts ) } );
is( scalar @warns, 0, 'no warnings from score_predict_split on undef column(s)' );
# Also verify the new method returns scores/labels consistent with
# score_predict_samples on the same data (numeric equality on scores,
# exact equality on labels).
my $pairs = $f->score_predict_samples( \@undef_pts );
my ( $scores, $labels ) = $f->score_predict_split( \@undef_pts );
is( scalar @$scores, scalar @$pairs, 'split returns matching scores length' );
is( scalar @$labels, scalar @$pairs, 'split returns matching labels length' );
my $mismatches = 0;
for my $i ( 0 .. $#$pairs ) {
$mismatches++ if $scores->[$i] != $pairs->[$i][0];
$mismatches++ if $labels->[$i] != $pairs->[$i][1];
}
is( $mismatches, 0, 'score_predict_split scores/labels match score_predict_samples element-for-element' );
}; ## end "[$be_name] score_predict_split emits no warnings with undef column(s)" => sub
subtest "[$be_name] extended mode: score_samples emits no warnings with undef column(s)" => sub {
t/32-pack-data.t view on Meta::CPAN
# ----- pack_data sanity -----
my $packed = $f->pack_data( \@query );
isa_ok( $packed, 'Algorithm::Classifier::IsolationForest::PackedData', 'pack_data returns a PackedData' );
is( $packed->n_pts, scalar @query, 'PackedData->n_pts matches' );
is( $packed->n_feats, 4, 'PackedData->n_feats matches' );
# ----- score_samples -----
subtest 'score_samples: packed == arrayref' => sub {
my $sa = $f->score_samples( \@query );
my $sp = $f->score_samples($packed);
is( scalar @$sa, scalar @$sp, 'same length' );
my $diffs = grep { $sa->[$_] != $sp->[$_] } 0 .. $#$sa;
is( $diffs, 0, 'every score matches bit-for-bit' );
};
# ----- predict -----
subtest 'predict: packed == arrayref' => sub {
my $la = $f->predict( \@query, 0.55 );
my $lp = $f->predict( $packed, 0.55 );
is( scalar @$la, scalar @$lp, 'same length' );
my $diffs = grep { $la->[$_] != $lp->[$_] } 0 .. $#$la;
is( $diffs, 0, 'every label matches' );
};
# ----- path_lengths -----
subtest 'path_lengths: packed == arrayref' => sub {
my $pa = $f->path_lengths( \@query );
my $pp = $f->path_lengths($packed);
is( scalar @$pa, scalar @$pp, 'same length' );
my $diffs = grep { $pa->[$_] != $pp->[$_] } 0 .. $#$pa;
is( $diffs, 0, 'every path length matches' );
};
# ----- score_predict_samples -----
subtest 'score_predict_samples: packed == arrayref' => sub {
my $pa = $f->score_predict_samples( \@query, 0.55 );
my $pp = $f->score_predict_samples( $packed, 0.55 );
is( scalar @$pa, scalar @$pp, 'same length' );
my $diffs = 0;
for my $i ( 0 .. $#$pa ) {
$diffs++ if $pa->[$i][0] != $pp->[$i][0];
$diffs++ if $pa->[$i][1] != $pp->[$i][1];
}
is( $diffs, 0, 'every [score, label] pair matches' );
}; ## end 'score_predict_samples: packed == arrayref' => sub
# ----- score_predict_split -----
subtest 'score_predict_split: packed == arrayref' => sub {
my ( $sa, $la ) = $f->score_predict_split( \@query, 0.55 );
my ( $sp, $lp ) = $f->score_predict_split( $packed, 0.55 );
is( scalar @$sa, scalar @$sp, 'scores same length' );
is( scalar @$la, scalar @$lp, 'labels same length' );
my $score_diffs = grep { $sa->[$_] != $sp->[$_] } 0 .. $#$sa;
my $label_diffs = grep { $la->[$_] != $lp->[$_] } 0 .. $#$la;
is( $score_diffs, 0, 'every score matches' );
is( $label_diffs, 0, 'every label matches' );
}; ## end 'score_predict_split: packed == arrayref' => sub
# ----- feature-count mismatch is fatal -----
subtest 'feature-count mismatch is detected' => sub {
my $other_f = $CLASS->new( n_trees => 10, sample_size => 16, seed => 1 );
$other_f->fit( [ map { [ gaussian( 0, 1 ), gaussian( 0, 1 ) ] } 1 .. 30 ] );
t/33-parallel-fit.t view on Meta::CPAN
plan skip_all => 'no fork() on this platform' unless $can_fork;
my $f1 = $CLASS->new(
n_trees => 25,
sample_size => 256,
seed => 17,
parallel_fit => 3,
)->fit( \@train );
my $json = $f1->to_json;
ok( length $json > 100, 'JSON has plausible body length' );
my $f2 = $CLASS->from_json($json);
is( scalar @{ $f2->{trees} }, 25, 'restored tree count matches' );
my $s1 = $f1->score_samples( \@query );
my $s2 = $f2->score_samples( \@query );
my $diffs = grep { abs( $s1->[$_] - $s2->[$_] ) > 1e-9 } 0 .. $#$s1;
is( $diffs, 0, 'restored model produces the same scores as the parallel-fit original' );
}; ## end 'parallel_fit + to_json/from_json round-trips' => sub
t/35-online-accel.t view on Meta::CPAN
# Prime the learned contamination threshold on the Perl path so both
# backends label against the identical cutoff.
with_knobs( $m, 0, 0, sub { $m->predict( \@eval ) } );
my %perl = with_knobs(
$m, 0, 0,
sub {
my ( $s, $l ) = $m->score_predict_split( \@eval );
return (
scores => $m->score_samples( \@eval ),
depths => $m->path_lengths( \@eval ),
labels => $m->predict( \@eval ),
pairs => $m->score_predict_samples( \@eval ),
split => [ $s, $l ],
);
}
);
my %c = with_knobs(
$m, 1, 0,
sub {
my ( $s, $l ) = $m->score_predict_split( \@eval );
return (
scores => $m->score_samples( \@eval ),
depths => $m->path_lengths( \@eval ),
labels => $m->predict( \@eval ),
pairs => $m->score_predict_samples( \@eval ),
split => [ $s, $l ],
);
}
);
for my $i ( 0 .. $#eval ) {
cmp_ok( $c{scores}[$i], '==', $perl{scores}[$i], "score_samples row $i identical" );
cmp_ok( $c{depths}[$i], '==', $perl{depths}[$i], "path_lengths row $i identical" );
is( $c{labels}[$i], $perl{labels}[$i], "predict row $i identical" );
cmp_ok( $c{pairs}[$i][0], '==', $perl{pairs}[$i][0], "score_predict score row $i identical" );
is( $c{pairs}[$i][1], $perl{pairs}[$i][1], "score_predict label row $i identical" );
cmp_ok( $c{split}[0][$i], '==', $perl{split}[0][$i], "split score row $i identical" );
is( $c{split}[1][$i], $perl{split}[1][$i], "split label row $i identical" );
}
}; ## end 'scoring parity: C vs pure Perl' => sub
subtest 'explicit and edge thresholds agree' => sub {
my $m = make_model();
t/35-online-accel.t view on Meta::CPAN
is_deeply( $c, $perl, "predict labels identical at threshold $thr" );
}
};
subtest 'mutation invalidates the packed snapshot' => sub {
my $m = make_model();
my $before = with_knobs( $m, 1, 0, sub { $m->score_samples( \@eval ) } );
ok( $m->{_c_nodes}, 'C snapshot exists after a C-path scoring call' );
# Learn a drifted cluster; the stream length also forces window
# evictions, so both learn and unlearn mutations are in play.
srand(8);
$m->learn( cluster( 300, 3 ) );
ok( !$m->{_c_nodes}, 'snapshot dropped by learning' );
my $c_after = with_knobs( $m, 1, 0, sub { $m->score_samples( \@eval ) } );
my $perl_after = with_knobs( $m, 0, 0, sub { $m->score_samples( \@eval ) } );
for my $i ( 0 .. $#eval ) {
cmp_ok( $c_after->[$i], '==', $perl_after->[$i], "post-mutation row $i matches fresh pure Perl" );
}
t/36-tagged-methods.t view on Meta::CPAN
# ---------------------------------------------------------------------------
# tagged_row_to_array
# ---------------------------------------------------------------------------
subtest 'tagged_row_to_array - happy path' => sub {
can_ok( $m, 'tagged_row_to_array' );
my $vec = $m->tagged_row_to_array( \%normal_row, 'test' );
is( ref $vec, 'ARRAY', 'returns an arrayref' );
is( scalar @$vec, 3, 'length matches number of features' );
is( $vec->[0], $normal_row{x}, 'x is in position 0' );
is( $vec->[1], $normal_row{y}, 'y is in position 1' );
is( $vec->[2], $normal_row{z}, 'z is in position 2' );
}; ## end 'tagged_row_to_array - happy path' => sub
subtest 'tagged_row_to_array - key order follows feature_names not hash order' => sub {
# Supply keys in a different order; result must follow @names.
my $vec = $m->tagged_row_to_array( { z => 3, x => 1, y => 2 }, 'test' );
is( $vec->[0], 1, 'x (index 0) correct despite hash ordering' );
is( $vec->[1], 2, 'y (index 1) correct despite hash ordering' );
t/38-online-basic.t view on Meta::CPAN
my $m = $class->new( window_size => $ws );
is( $m->{window_size}, 0, 'window_size ' . ( defined $ws ? $ws : 'undef' ) . ' => unbounded' );
}
}; ## end 'constructor validation' => sub
subtest 'scoring before any data croaks' => sub {
my $m = $class->new;
ok( !eval { $m->score_samples( [ [ 1, 2 ] ] ); 1 }, 'score_samples croaks unlearned' );
like( $@, qr/learn/, 'error mentions learn()' );
ok( !eval { $m->predict( [ [ 1, 2 ] ] ); 1 }, 'predict croaks unlearned' );
ok( !eval { $m->path_lengths( [ [ 1, 2 ] ] ); 1 }, 'path_lengths croaks unlearned' );
};
subtest 'learn/score sanity' => sub {
srand(7);
my $m = $class->new(
seed => 42,
n_trees => 50,
window_size => 256,
max_leaf_samples => 16,
);
t/38-online-basic.t view on Meta::CPAN
is( $ret, $m, 'learn returns $self' );
my $scores = $m->score_samples( [ [ 0, 0 ], [ 8, 8 ], [ -7, 7 ] ] );
is( scalar @$scores, 3, 'one score per sample' );
for my $s (@$scores) {
ok( $s > 0 && $s <= 1, "score $s in (0, 1]" );
}
cmp_ok( $scores->[1], '>', $scores->[0] + 0.03, 'far outlier scores above the cluster centre' );
cmp_ok( $scores->[2], '>', $scores->[0] + 0.03, 'other outlier scores above the cluster centre' );
my $depths = $m->path_lengths( [ [ 0, 0 ], [ 8, 8 ] ] );
cmp_ok( $depths->[0], '>', $depths->[1], 'inlier isolates deeper than the outlier' );
my ( $s2, $l2 ) = $m->score_predict_split( [ [ 0, 0 ], [ 8, 8 ] ], $scores->[0] + 0.01 );
is_deeply( $l2, [ 0, 1 ], 'score_predict_split labels against an explicit threshold' );
my $pairs = $m->score_predict_samples( [ [ 0, 0 ], [ 8, 8 ] ], $scores->[0] + 0.01 );
is_deeply( [ map { $_->[1] } @$pairs ], [ 0, 1 ], 'score_predict_samples labels agree' );
}; ## end 'learn/score sanity' => sub
subtest 'window bookkeeping' => sub {
srand(8);
( run in 2.870 seconds using v1.01-cache-2.11-cpan-54e63673c56 )