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
psi referenced below is ψ or the pitchfork math symbol referenced in the paper,
Liu, Fei Tony & Ting, Kai & Zhou, Zhi-Hua. (2008). Isolation Forest. 413 - 422. 10.1109/ICDM.2008.17.
... or max samples.
L<https://www.researchgate.net/publication/224384174_Isolation_Forest>
=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
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
=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.
#-------------------------------------------------------------------------------
sub _c {
my ($n) = @_;
return 0.0 if $n <= 1;
return 1.0 if $n == 2;
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.
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.
#-------------------------------------------------------------------------------
sub _threshold_from_ranked {
my ( $desc, $k ) = @_;
my $n = scalar @$desc;
return $desc->[ $n - 1 ] - 1e-9 if $k >= $n; # flag everything
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.
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
#-------------------------------------------------------------------------------
# Contamination support for majority voting: each training point's majority
# pivot -- the per-tree score threshold at which the point loses its
# majority. A point is flagged at cutoff theta iff at least min_votes of
# its per-tree path lengths h satisfy h <= -c*log2(theta), which holds iff
# its min_votes-th SMALLEST path length h_(maj) does, i.e. iff
# 2**(-h_(maj)/c) >= theta. So the pivot m = 2**(-h_(maj)/c) relates to
# the majority-mode threshold exactly as the mean-mode score relates to
# its threshold, and fit()'s midpoint selection works on either unchanged.
#
# Pure Perl by necessity: the per-tree path lengths never cross the C
# boundary individually (score_all_xs/vote_all_xs only return per-point
# aggregates), and fit() has already dropped any stale packed buffers when
# this runs -- the same situation as mean mode's training-set scoring pass.
#-------------------------------------------------------------------------------
# Learn the contamination cutoff for the CURRENT voting mode from a training
# set. Ranks the per-point quantity the active aggregation thresholds against
# -- the mean-mode anomaly score, or the majority pivot under
# voting => 'majority' -- and lands the cutoff midway inside a real gap between
# flagged and unflagged values (ties at the k-boundary shift it to the nearest
# gap; see _threshold_from_ranked), so it sits strictly between attainable
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.
sub _randn {
my $u1 = rand() || 1e-12;
my $u2 = rand();
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.
#-------------------------------------------------------------------------------
# The optional $nan flag selects the nan-strategy routing: a point missing
# the split feature goes to the right child (matching the C scorer, where
# the NaN comparison is false). Without it, undef is coerced to 0 -- the
# behaviour the die/zero/impute strategies rely on (their data is dense by
# the time it reaches here, so the "// 0" is normally a no-op).
sub _path_length {
my ( $x, $node, $depth, $nan ) = @_;
while ( $node->[0] ) { # false only for leaf (type 0)
if ( $node->[0] == _NODE_AXIS ) { # [1, attr, split, left, right]
if ($nan) {
my $v = $x->[ $node->[1] ];
$node = ( defined($v) && $v < $node->[2] ) ? $node->[3] : $node->[4];
} else {
$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
# Recursively convert a version-0 hash-based tree node to the version-1
# array format. Called by from_json when loading an old saved model.
sub _hash_node_to_array {
my ($node) = @_;
if ( $node->{leaf} ) {
return [ _NODE_LEAF, $node->{size} ];
} elsif ( exists $node->{attr} ) {
return [
_NODE_AXIS, $node->{attr},
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
# 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
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. Returns the rows; the
# caller passes the nan flag to _path_length separately.
sub _prepare_perl_input {
my ( $self, $data ) = @_;
my $rows = $self->_to_arrayref($data);
if ( $self->{missing} eq 'impute' ) {
croak "impute model is missing its fill vector"
unless ref $self->{missing_fill} eq 'ARRAY';
$rows = _densify( $rows, $self->{missing_fill} );
}
return $rows;
} ## end sub _prepare_perl_input
lib/Algorithm/Classifier/IsolationForest/App/Command/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
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
sub _write_packed {
my ( $path, $n_pts, $n_feats, $bytes ) = @_;
my $hdr = pack( 'a8 v v V V', MAGIC, VERSION, 0, $n_pts, $n_feats );
write_file( $path, { 'atomic' => 1, 'binmode' => ':raw' }, $hdr . $bytes );
}
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
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
=cut
sub score_sample_tagged {
my ( $self, $row ) = @_;
my $vec = $self->tagged_row_to_array( $row, 'score_sample_tagged' );
my $result = $self->score_samples( [$vec] );
return $result->[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>), otherwise 0.5.
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 1.148 second using v1.01-cache-2.11-cpan-995e09ba956 )