File Coverage

blib/lib/Algorithm/Classifier/IsolationForest.pm
Criterion Covered Total %
statement 858 902 95.1
branch 368 436 84.4
condition 214 295 72.5
subroutine 77 79 97.4
pod 28 28 100.0
total 1545 1740 88.7


line stmt bran cond sub pod time code
1             package Algorithm::Classifier::IsolationForest;
2              
3 124     124   14429076 use strict;
  124         212  
  124         4337  
4 124     124   576 use warnings;
  124         462  
  124         5938  
5 124     124   652 use Carp qw(croak);
  124         229  
  124         6786  
6 124     124   544 use Config ();
  124         268  
  124         2966  
7 124     124   507 use List::Util qw(min);
  124         189  
  124         10721  
8 124     124   53267 use POSIX qw(ceil);
  124         735640  
  124         643  
9 124     124   171803 use JSON::PP ();
  124         480754  
  124         2975  
10 124     124   59082 use File::Slurp qw(read_file write_file);
  124         2231705  
  124         10169  
11              
12             our $VERSION = '0.6.0';
13              
14 124     124   839 use constant EULER => 0.5772156649015329;
  124         199  
  124         8730  
15              
16             # Narrowed to C double precision so _randn() multiplies by the exact
17             # constant _c_randn() uses. A no-op on nvsize == 8 perls.
18 124     124   549 use constant TWO_PI => unpack( 'd', pack 'd', 6.283185307179586 );
  124         211  
  124         5164  
19              
20             # Node-type tags stored in index 0 of every tree node arrayref.
21             # 0 is falsy, so while ($node->[0]) acts as while (!leaf).
22 124     124   516 use constant _NODE_LEAF => 0;
  124         214  
  124         4029  
23 124     124   497 use constant _NODE_AXIS => 1;
  124         195  
  124         3855  
24 124     124   426 use constant _NODE_OBLIQUE => 2;
  124         196  
  124         6214  
25              
26             # The Inline::C tree builder computes everything in C doubles. On a perl
27             # whose NV is wider than a double (-Duselongdouble / -Dusequadmath) the
28             # pure-Perl builder keeps extra low bits at every step, so the two
29             # backends would stop producing bit-identical trees for the same seed
30             # (the parity t/03-fit-determinism.t checks). _NV_IS_DOUBLE guards
31             # narrowing statements wherever the pure-Perl builder computes a value
32             # that gets STORED in a tree (split points, hyperplane coefficients and
33             # offsets, impute fills), rounding at the same points the C builder
34             # rounds. It is compile-time true on nvsize == 8 perls, so there the
35             # guarded statements are optimised away and cost nothing.
36             #
37             # The row-partition loops (v < split, dot <= b) are deliberately NOT
38             # narrowed: with both operands already double-exact an axis comparison
39             # is identical anyway, and an oblique dot product accumulated in a wider
40             # NV flips a comparison only when |dot - b| falls inside the NV-vs-double
41             # rounding gap (~1e-19 relative) -- negligible, and those are the hot
42             # loops.
43 124     124   522 use constant _NV_IS_DOUBLE => $Config::Config{nvsize} == 8;
  124         206  
  124         1584119  
44              
45             # Round an NV to C double precision. Only ever reached on wide-NV
46             # perls -- see _NV_IS_DOUBLE.
47 0     0   0 sub _to_double { unpack 'd', pack 'd', $_[0] }
48              
49             # ---------------------------------------------------------------------------
50             # Optional Inline::C accelerator for the scoring hot path.
51             #
52             # pack_input_xs(data_sv, out_sv, n_pts, n_feats, miss_mode, fill_sv)
53             # Walks the Perl arrayref-of-arrayrefs and writes a packed double buffer
54             # into out_sv. Replaces the dominant per-call Perl map-pack loop.
55             # miss_mode selects how an undef cell is packed: 0 => 0.0, 1 => the
56             # per-feature fill from fill_sv (impute), 2 => NaN (nan strategy).
57             #
58             # score_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
59             # n_pts, n_feats, n_trees, use_openmp)
60             # Sums path lengths for all n_pts query points across all n_trees trees
61             # in one call. Outer loop over points is OpenMP-parallel when the
62             # module was built with OpenMP (each iteration writes to a unique sm[i],
63             # so no synchronisation is needed). Tree pointers are extracted from
64             # the AVs before the parallel region; the parallel region touches only
65             # raw int / double buffers.
66             #
67             # vote_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
68             # n_pts, n_feats, n_trees, depth_cut, min_votes, use_openmp)
69             # Majority-voting (voting => 'majority') counterpart of score_all_xs:
70             # instead of summing path lengths it counts, per point, how many trees
71             # "vote anomalous" (path length <= depth_cut). min_votes == 0 writes
72             # the full vote count into sm[i]; min_votes > 0 writes a 0.0/1.0 label
73             # with per-point early exit once the majority outcome is decided --
74             # the MVIForest scoring loop. See the function's own comment.
75             #
76             # Node layout (6 doubles per node, "IF_NZ = 6"):
77             # leaf: [0, size, c(size), 0, 0, 0]
78             # axis: [1, attr, split, li, ri, 0]
79             # oblique: [2, coff, nf, li, ri, b]
80             #
81             # c(size) is the expected-path-length adjustment for a leaf holding
82             # `size` points, precomputed by _pack_tree (it involves a log(); doing
83             # it at pack time keeps transcendentals out of the per-point per-tree
84             # scoring loop). The fit-time TreeBuf writer leaves that slot 0 --
85             # its buffers are unpacked into Perl trees and re-packed by
86             # _pack_tree before score_all_xs ever sees them.
87             #
88             # Coefficient storage uses a Structure-of-Arrays layout: one int32 array
89             # per tree (feature indices, packed with 'l*') and one double array per
90             # tree (coefficients, packed with 'd*'). Both are indexed by `coff` --
91             # the same offset addresses paired entries in the two arrays. Splitting
92             # them this way halves index bandwidth, removes the per-element
93             # (int) cast inside the SIMD loop, and lets the value loads be
94             # contiguous so the compiler emits a clean FMA chain over val[k] with
95             # the feature gather on xi[idx[k]] kept separate.
96             #
97             # Dense-pack fast path: when an oblique node uses every feature (the
98             # common case in extended mode with extension_level == n_features - 1),
99             # _pack_tree writes its coefficients in feature order so val[k] is the
100             # coefficient for feature k. score_all_xs detects this via `nf ==
101             # n_feats` and uses a no-gather dot product (dot += val[k] * xi[k])
102             # that vectorizes cleanly with FMA -- substantially faster than the
103             # sparse gather path on high-feature-count models.
104             # x: row-major doubles, n_pts rows of n_feats each.
105             # sums: out double array of length n_pts; score_all_xs writes once per i.
106             #
107             # OpenMP is enabled at module load when the toolchain accepts -fopenmp and
108             # libgomp is linkable; otherwise the same C code compiles to a serial loop
109             # (the #pragma is silently ignored without _OPENMP defined).
110             # ---------------------------------------------------------------------------
111             our $HAS_C = 0;
112             our $HAS_OPENMP = 0;
113             our $HAS_SIMD = 0;
114             our $OPT_LEVEL = ''; # the actual -O.../-march=... flags used to build, if any
115             our $C_SOURCE = ''; # 'prebuilt' (object installed at `make` time) or
116             # 'runtime' (compiled at first load into _Inline/);
117             # '' when $HAS_C is 0
118             {
119             my $C_CODE = <<'__INLINE_C__';
120             #include
121             #include
122             #include
123             #ifdef _OPENMP
124             #include
125             #endif
126             #define IF_NZ 6
127              
128             /* Data prefetch hint; a no-op on compilers without __builtin_prefetch.
129             * Purely a performance hint -- never affects results. */
130             #if defined(__GNUC__) || defined(__clang__)
131             #define IF_PREFETCH(p) __builtin_prefetch(p)
132             #else
133             #define IF_PREFETCH(p)
134             #endif
135              
136             int has_openmp_xs(){
137             #ifdef _OPENMP
138             return 1;
139             #else
140             return 0;
141             #endif
142             }
143              
144             /* SIMD on the extended-mode oblique dot product is enabled via
145             * `#pragma omp simd`, which OpenMP 4.0 (_OPENMP == 201307) introduced.
146             * Anything older silently ignores the pragma -- the loop still runs,
147             * just not auto-vectorised. So "simd available" really means the
148             * compiler is going to honour the pragma we put on that loop. */
149             int has_simd_xs(){
150             #if defined(_OPENMP) && _OPENMP >= 201307
151             return 1;
152             #else
153             return 0;
154             #endif
155             }
156              
157             /* pack_input_xs(data_sv, out_sv, n_pts, n_feats, miss_mode, fill_sv)
158             *
159             * Walks a Perl arrayref-of-arrayrefs (n_pts rows of n_feats doubles each)
160             * directly in C and writes the packed double buffer into out_sv (which the
161             * caller pre-allocates with "\0" x (n_pts*n_feats*8)). Replaces
162             *
163             * pack('d*', map { my $r=$_; map { $r->[$_] // 0 } 0..$nf-1 } @$data)
164             *
165             * which was the dominant per-call overhead for high feature counts.
166             *
167             * miss_mode selects what an undef cell (or missing row) becomes:
168             * 0 => 0.0 (the 'die'/'zero' missing strategies)
169             * 1 => fill[k] (the 'impute' strategy; fill_sv is a packed
170             * double buffer of n_feats per-feature fill values)
171             * 2 => NaN (the 'nan' strategy; the C scorer's `<` / `<=`
172             * comparisons are both false for NaN, so a point
173             * missing the split feature falls to the right
174             * child -- matching how fit() routes it)
175             * fill_sv is only dereferenced when miss_mode == 1. */
176             void pack_input_xs(SV* data_sv, SV* out_sv, int n_pts, int n_feats,
177             int miss_mode, SV* fill_sv){
178             STRLEN tl;
179             double* out;
180             const double* fill = NULL;
181             double missval;
182             AV* outer;
183             int i, k;
184              
185             if (!SvROK(data_sv) || SvTYPE(SvRV(data_sv)) != SVt_PVAV) {
186             croak("pack_input_xs: data must be an arrayref");
187             }
188             outer = (AV*)SvRV(data_sv);
189             out = (double*)SvPVbyte_force(out_sv, tl);
190              
191             if (miss_mode == 1) {
192             STRLEN fl;
193             fill = (const double*)SvPVbyte(fill_sv, fl);
194             }
195             missval = (miss_mode == 2) ? NAN : 0.0;
196              
197             for (i = 0; i < n_pts; i++) {
198             SV** row_pp = av_fetch(outer, i, 0);
199             double* dst = out + (size_t)i * (size_t)n_feats;
200             if (!row_pp || !*row_pp || !SvROK(*row_pp) ||
201             SvTYPE(SvRV(*row_pp)) != SVt_PVAV) {
202             for (k = 0; k < n_feats; k++)
203             dst[k] = (miss_mode == 1) ? fill[k] : missval;
204             continue;
205             }
206             {
207             AV* row = (AV*)SvRV(*row_pp);
208             for (k = 0; k < n_feats; k++) {
209             SV** v = av_fetch(row, k, 0);
210             if (v && *v && SvOK(*v)) {
211             dst[k] = SvNV(*v);
212             } else {
213             dst[k] = (miss_mode == 1) ? fill[k] : missval;
214             }
215             }
216             }
217             }
218             }
219              
220             /* finalize_scores_xs(sm_sv, n_pts, inv, out_rv)
221             *
222             * Fills the pre-allocated arrayref out_rv with exp(-sm[i] * inv) for
223             * i in 0..n_pts-1. Replaces the trailing
224             *
225             * my @sums = unpack('d*', $sums_packed);
226             * return [ map { exp(-$_ * $inv) } @sums ];
227             *
228             * which allocated ~2*n_pts intermediate Perl SVs per scoring call. */
229             void finalize_scores_xs(SV* sm_sv, int n_pts, double inv, SV* out_rv){
230             STRLEN tl;
231             const double* sm;
232             AV* out;
233             int i;
234              
235             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
236             croak("finalize_scores_xs: out must be an arrayref");
237             }
238             sm = (const double*)SvPVbyte(sm_sv, tl);
239             out = (AV*)SvRV(out_rv);
240             av_clear(out);
241             if (n_pts > 0) av_extend(out, n_pts - 1);
242             for (i = 0; i < n_pts; i++) {
243             av_store(out, i, newSVnv(exp(-sm[i] * inv)));
244             }
245             }
246              
247             /* finalize_path_lengths_xs(sm_sv, n_pts, t, out_rv)
248             *
249             * Same idea as finalize_scores_xs but writes sm[i] / t (the average path
250             * length across n_trees=t trees) instead of the exp normalisation. */
251             void finalize_path_lengths_xs(SV* sm_sv, int n_pts, double t, SV* out_rv){
252             STRLEN tl;
253             const double* sm;
254             AV* out;
255             int i;
256              
257             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
258             croak("finalize_path_lengths_xs: out must be an arrayref");
259             }
260             sm = (const double*)SvPVbyte(sm_sv, tl);
261             out = (AV*)SvRV(out_rv);
262             av_clear(out);
263             if (n_pts > 0) av_extend(out, n_pts - 1);
264             for (i = 0; i < n_pts; i++) {
265             av_store(out, i, newSVnv(sm[i] / t));
266             }
267             }
268              
269             /* predict_sums_xs(sm_sv, n_pts, sum_threshold, out_rv)
270             *
271             * Fills out_rv with 0/1 IVs based on sm[i] <= sum_threshold. The caller
272             * pre-computes sum_threshold = -log(score_threshold) * c * n_trees / log(2),
273             * so this skips both the per-point exp() and the intermediate scores
274             * arrayref that the old "score_samples + map threshold" path created. */
275             void predict_sums_xs(SV* sm_sv, int n_pts, double sum_threshold, SV* out_rv){
276             STRLEN tl;
277             const double* sm;
278             AV* out;
279             int i;
280              
281             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
282             croak("predict_sums_xs: out must be an arrayref");
283             }
284             sm = (const double*)SvPVbyte(sm_sv, tl);
285             out = (AV*)SvRV(out_rv);
286             av_clear(out);
287             if (n_pts > 0) av_extend(out, n_pts - 1);
288             for (i = 0; i < n_pts; i++) {
289             av_store(out, i, newSViv(sm[i] <= sum_threshold ? 1 : 0));
290             }
291             }
292              
293             /* score_predict_xs(sm_sv, n_pts, inv, sum_threshold, out_rv)
294             *
295             * Combines finalize_scores_xs + predict_sums_xs: fills the pre-allocated
296             * out_rv with [score, label] pairs in one pass over sm_sv. Replaces the
297             * trailing Perl loop in score_predict_samples that built ~3*n_pts SVs
298             * (n_pts scores + n_pts labels + n_pts inner arrayrefs) via a Perl
299             * foreach -- here the same SVs are allocated directly inside C.
300             *
301             * Refcount note: newRV_noinc takes ownership of the inner AV without
302             * incrementing it, and av_store takes ownership of the RV. When the
303             * outer AV is destroyed it frees the RVs, which free the inner AVs,
304             * which free the score/label SVs. No leak. */
305             void score_predict_xs(SV* sm_sv, int n_pts, double inv,
306             double sum_threshold, SV* out_rv){
307             STRLEN tl;
308             const double* sm;
309             AV* out;
310             int i;
311              
312             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
313             croak("score_predict_xs: out must be an arrayref");
314             }
315             sm = (const double*)SvPVbyte(sm_sv, tl);
316             out = (AV*)SvRV(out_rv);
317             av_clear(out);
318             if (n_pts > 0) av_extend(out, n_pts - 1);
319             for (i = 0; i < n_pts; i++) {
320             AV* row = newAV();
321             av_extend(row, 1);
322             /* av_extend filled both slots with &PL_sv_undef. Since that
323             * sentinel is immortal (its refcount is never freed) we can
324             * overwrite the slots directly and bump AvFILLp, skipping the
325             * per-element bounds/magic checks av_store would do. */
326             AvARRAY(row)[0] = newSVnv(exp(-sm[i] * inv));
327             AvARRAY(row)[1] = newSViv(sm[i] <= sum_threshold ? 1 : 0);
328             AvFILLp(row) = 1;
329             av_store(out, i, newRV_noinc((SV*)row));
330             }
331             }
332              
333             /* score_predict_split_xs(sm_sv, n_pts, inv, sum_threshold,
334             * scores_rv, labels_rv)
335             *
336             * Parallel-arrays variant of score_predict_xs: fills two pre-allocated
337             * arrayrefs (scores: NV, labels: IV) instead of an AV-of-[score, label]
338             * pairs. Allocates ~2*n_pts SVs instead of ~4*n_pts -- no inner AV and
339             * no RV per point -- so it's about twice as cheap for callers that
340             * don't need the paired shape. */
341             void score_predict_split_xs(SV* sm_sv, int n_pts, double inv,
342             double sum_threshold,
343             SV* scores_rv, SV* labels_rv){
344             STRLEN tl;
345             const double* sm;
346             AV* scores;
347             AV* labels;
348             int i;
349              
350             if (!SvROK(scores_rv) || SvTYPE(SvRV(scores_rv)) != SVt_PVAV ||
351             !SvROK(labels_rv) || SvTYPE(SvRV(labels_rv)) != SVt_PVAV) {
352             croak("score_predict_split_xs: scores/labels must be arrayrefs");
353             }
354             sm = (const double*)SvPVbyte(sm_sv, tl);
355             scores = (AV*)SvRV(scores_rv);
356             labels = (AV*)SvRV(labels_rv);
357             av_clear(scores);
358             av_clear(labels);
359             if (n_pts > 0) {
360             av_extend(scores, n_pts - 1);
361             av_extend(labels, n_pts - 1);
362             }
363             for (i = 0; i < n_pts; i++) {
364             av_store(scores, i, newSVnv(exp(-sm[i] * inv)));
365             av_store(labels, i, newSViv(sm[i] <= sum_threshold ? 1 : 0));
366             }
367             }
368              
369             /* Walk one point through one tree; returns the path length (depth plus
370             * the precomputed c(leaf size) adjustment from the leaf record).
371             *
372             * Invariant: every feature index stored in a tree node is in
373             * [0, n_feats). fit() builds trees against n_features columns and
374             * pack_input_xs writes exactly that many doubles per row, and
375             * _resolve_input rejects PackedData with a mismatched feature count.
376             * So the loop can omit per-iteration bounds checks on attr / fi --
377             * this is what lets the oblique dot product vectorize cleanly under
378             * the omp-simd reductions below. */
379             #if defined(__GNUC__) || defined(__clang__)
380             __attribute__((always_inline))
381             #endif
382             static inline double if_walk_tree(const double *nd, const int *ico,
383             const double *vco, const double *xi,
384             int n_feats) {
385             int ni = 0, depth = 0;
386             for (;;) {
387             const double *node = nd + (size_t)ni * IF_NZ;
388             int type = (int)node[0];
389             if (type == 0) {
390             /* node[2] is c(leaf size), precomputed by _pack_tree; a
391             * log() here would otherwise run once per point per tree. */
392             return depth + node[2];
393             }
394             if (type == 1) {
395             double fv = xi[(int)node[1]];
396             ni = (fv < node[2]) ? (int)node[3] : (int)node[4];
397             } else {
398             int coff = (int)node[1], nf = (int)node[2];
399             double b = node[5], dot = 0.0;
400             const double *val_p = vco + (size_t)coff;
401              
402             /* Both children are known before the dot product resolves
403             * which one gets taken, so start pulling their records in
404             * now and let the FMA loop below hide the latency. One of
405             * the two prefetches is always wasted -- affordable here
406             * on the oblique path, where there is real work to hide it
407             * under, but not on the axis path, whose single compare
408             * resolves immediately. */
409             const int li = (int)node[3], ri = (int)node[4];
410             IF_PREFETCH(nd + (size_t)li * IF_NZ);
411             IF_PREFETCH(nd + (size_t)ri * IF_NZ);
412             if (nf == n_feats) {
413             /* Dense oblique split: this node uses every feature,
414             * so _pack_tree laid the coefficients out in feature
415             * order. No gather -- the inner loop is a textbook
416             * FMA-vectorizable dot product over two contiguous
417             * double streams. Common case in extended mode at
418             * the default extension_level (== n_feats-1). */
419             #ifdef _OPENMP
420             #pragma omp simd reduction(+:dot)
421             #endif
422             for (int k = 0; k < n_feats; k++) {
423             dot += val_p[k] * xi[k];
424             }
425             } else {
426             /* Sparse oblique split: only nf < n_feats features
427             * participate, so we still need the gather on
428             * xi[idx_p[k]]. Storing idx as contiguous int32
429             * (rather than interleaved doubles) keeps the gather
430             * pattern clean and the val[] load contiguous. */
431             const int *idx_p = ico + (size_t)coff;
432             #ifdef _OPENMP
433             #pragma omp simd reduction(+:dot)
434             #endif
435             for (int k = 0; k < nf; k++) {
436             dot += val_p[k] * xi[idx_p[k]];
437             }
438             }
439             ni = (dot <= b) ? li : ri;
440             }
441             depth++;
442             }
443             }
444              
445             /* score_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
446             * n_pts, n_feats, n_trees, use_openmp)
447             *
448             * Scores all points across all trees in one C call. See header comment
449             * above for the bigger picture. Writes sm[i] = sum_over_trees(path_len);
450             * the caller need not zero-init sm.
451             *
452             * idx_av holds per-tree packed int32 buffers of feature indices and
453             * val_av holds per-tree packed double buffers of coefficients (the SoA
454             * counterpart of the old interleaved layout). See the file-top
455             * comment for the rationale.
456             *
457             * Thread-safety: the parallel region only reads node/idx/val/x pointers
458             * (extracted before the region) and writes sm[i] for a unique i per
459             * iteration. No Perl API is called from inside the parallel region. */
460             void score_all_xs(SV* nodes_av_sv, SV* idx_av_sv, SV* val_av_sv,
461             SV* x_sv, SV* sm_sv,
462             int n_pts, int n_feats, int n_trees,
463             int use_openmp){
464             STRLEN tl;
465             AV *nodes_av, *idx_av, *val_av;
466             const double *xd;
467             double *sm;
468             int ti;
469              
470             if (!SvROK(nodes_av_sv) || SvTYPE(SvRV(nodes_av_sv)) != SVt_PVAV ||
471             !SvROK(idx_av_sv) || SvTYPE(SvRV(idx_av_sv)) != SVt_PVAV ||
472             !SvROK(val_av_sv) || SvTYPE(SvRV(val_av_sv)) != SVt_PVAV) {
473             croak("score_all_xs: nodes/idx/val must be arrayrefs");
474             }
475             nodes_av = (AV*)SvRV(nodes_av_sv);
476             idx_av = (AV*)SvRV(idx_av_sv);
477             val_av = (AV*)SvRV(val_av_sv);
478              
479             /* C99 VLAs -- n_trees is small (typ. 100) and fits on the stack. */
480             const double *node_ptrs[n_trees];
481             const int *idx_ptrs[n_trees];
482             const double *val_ptrs[n_trees];
483              
484             /* forest_bytes totals every buffer the tree walks touch; it decides
485             * between the two loop shapes below. */
486             size_t forest_bytes = 0;
487             for (ti = 0; ti < n_trees; ti++) {
488             SV** np = av_fetch(nodes_av, ti, 0);
489             SV** ip = av_fetch(idx_av, ti, 0);
490             SV** vp = av_fetch(val_av, ti, 0);
491             if (!np || !*np || !ip || !*ip || !vp || !*vp) {
492             croak("score_all_xs: missing tree %d", ti);
493             }
494             node_ptrs[ti] = (const double*)SvPVbyte(*np, tl); forest_bytes += tl;
495             idx_ptrs[ti] = (const int*) SvPVbyte(*ip, tl); forest_bytes += tl;
496             val_ptrs[ti] = (const double*)SvPVbyte(*vp, tl); forest_bytes += tl;
497             }
498              
499             xd = (const double*)SvPVbyte(x_sv, tl);
500             sm = (double*)SvPVbyte_force(sm_sv, tl);
501              
502             /* Two loop shapes over the same per-point ascending-t additions --
503             * bit-identical results either way, so the size heuristic choosing
504             * between them can never change scores.
505             *
506             * Point-major (small forests): each point walks all trees with its
507             * path-length sum held in a register. Cheapest per walk, and the
508             * whole forest stays cache-resident across points anyway.
509             *
510             * Tree-blocked (large forests): once the forest outgrows L3, the
511             * point-major loop re-streams every tree's nodes and coefficients
512             * from memory for every point -- an extended-mode tree is ~56 KB
513             * at 16 features (24 KB nodes + 32 KB dense coefficients), and its
514             * per-tree scoring cost measured 2.2x worse at 400 trees than at
515             * 100. Walking a block of points through ONE tree at a time keeps
516             * that tree hot in L1/L2 while the block's rows stream through it
517             * (measured 3.1x faster at 400 extended trees, 20k points). The
518             * blocked shape pays an sm[i] load+store per walk instead of a
519             * register add, which measurably hurts cheap axis walks while the
520             * forest still fits in cache -- hence the byte threshold rather
521             * than always tiling. */
522             if (forest_bytes <= (size_t)4 * 1024 * 1024) {
523             #ifdef _OPENMP
524             #pragma omp parallel for schedule(static) if(use_openmp)
525             #endif
526             for (int i = 0; i < n_pts; i++) {
527             const double *xi = xd + (size_t)i * (size_t)n_feats;
528             double sum = 0.0;
529             for (int t = 0; t < n_trees; t++) {
530             sum += if_walk_tree(node_ptrs[t], idx_ptrs[t],
531             val_ptrs[t], xi, n_feats);
532             }
533             sm[i] = sum;
534             }
535             }
536             else {
537             /* 256 rows x 16 features x 8 bytes = 32 KB of input per block
538             * -- comfortable in L2 next to one tree. Each OpenMP thread
539             * owns whole blocks and therefore a unique slice of sm[], so
540             * there is still no synchronisation. For small batches the
541             * tile shrinks to keep ~4 blocks per thread available; losing
542             * per-block tree reuse there is fine, since a small batch
543             * never re-streams much anyway. */
544             int tile = 256;
545             #ifdef _OPENMP
546             if (use_openmp) {
547             int min_blocks = omp_get_max_threads() * 4;
548             if (min_blocks > 0 && (n_pts + tile - 1) / tile < min_blocks) {
549             tile = (n_pts + min_blocks - 1) / min_blocks;
550             if (tile < 1) tile = 1;
551             }
552             }
553             #endif
554             int n_blocks = (n_pts + tile - 1) / tile;
555              
556             #ifdef _OPENMP
557             #pragma omp parallel for schedule(static) if(use_openmp)
558             #endif
559             for (int blk = 0; blk < n_blocks; blk++) {
560             const int i0 = blk * tile;
561             const int i1 = (i0 + tile < n_pts) ? i0 + tile : n_pts;
562             for (int i = i0; i < i1; i++) sm[i] = 0.0;
563             for (int t = 0; t < n_trees; t++) {
564             const double *nd = node_ptrs[t];
565             const int *ico = idx_ptrs[t];
566             const double *vco = val_ptrs[t];
567             for (int i = i0; i < i1; i++) {
568             sm[i] += if_walk_tree(nd, ico, vco,
569             xd + (size_t)i * (size_t)n_feats,
570             n_feats);
571             }
572             }
573             }
574             }
575             }
576              
577             /* vote_all_xs(nodes_av, idx_av, val_av, x_sv, sm_sv,
578             * n_pts, n_feats, n_trees, depth_cut, min_votes, use_openmp)
579             *
580             * Majority-voting (MVIForest) tree walk: a tree votes a point anomalous
581             * when the point's path length in that tree is <= depth_cut -- the
582             * depth-domain image of the per-tree score cutoff (the Perl side
583             * precomputes depth_cut = -c(psi) * log2(threshold), so no per-tree
584             * exp()/log() runs in here).
585             *
586             * min_votes == 0: sm[i] = the point's full vote count over all n_trees
587             * trees (a small integer stored as a double, so the existing
588             * finalize_* helpers work on the buffer unchanged).
589             * min_votes > 0: sm[i] = 1.0/0.0 anomaly label, with per-point early
590             * exit: the walk stops as soon as the point has min_votes votes (the
591             * remaining trees can't change the outcome) or can no longer reach
592             * min_votes. This is MVIForest's "stop at majority" scoring loop.
593             *
594             * Always point-major, unlike score_all_xs's two loop shapes: the vote
595             * count / early exit is per-point state, so a tree-blocked loop would
596             * have to re-load it per walk and could never exit a point early.
597             * Votes are integer counts, so there is no summation-order concern
598             * either way. Thread-safety matches score_all_xs: the parallel region
599             * reads extracted pointers and writes a unique sm[i] per iteration. */
600             void vote_all_xs(SV* nodes_av_sv, SV* idx_av_sv, SV* val_av_sv,
601             SV* x_sv, SV* sm_sv,
602             int n_pts, int n_feats, int n_trees,
603             double depth_cut, int min_votes, int use_openmp){
604             STRLEN tl;
605             AV *nodes_av, *idx_av, *val_av;
606             const double *xd;
607             double *sm;
608             int ti;
609              
610             if (!SvROK(nodes_av_sv) || SvTYPE(SvRV(nodes_av_sv)) != SVt_PVAV ||
611             !SvROK(idx_av_sv) || SvTYPE(SvRV(idx_av_sv)) != SVt_PVAV ||
612             !SvROK(val_av_sv) || SvTYPE(SvRV(val_av_sv)) != SVt_PVAV) {
613             croak("vote_all_xs: nodes/idx/val must be arrayrefs");
614             }
615             nodes_av = (AV*)SvRV(nodes_av_sv);
616             idx_av = (AV*)SvRV(idx_av_sv);
617             val_av = (AV*)SvRV(val_av_sv);
618              
619             const double *node_ptrs[n_trees];
620             const int *idx_ptrs[n_trees];
621             const double *val_ptrs[n_trees];
622              
623             for (ti = 0; ti < n_trees; ti++) {
624             SV** np = av_fetch(nodes_av, ti, 0);
625             SV** ip = av_fetch(idx_av, ti, 0);
626             SV** vp = av_fetch(val_av, ti, 0);
627             if (!np || !*np || !ip || !*ip || !vp || !*vp) {
628             croak("vote_all_xs: missing tree %d", ti);
629             }
630             node_ptrs[ti] = (const double*)SvPVbyte(*np, tl);
631             idx_ptrs[ti] = (const int*) SvPVbyte(*ip, tl);
632             val_ptrs[ti] = (const double*)SvPVbyte(*vp, tl);
633             }
634              
635             xd = (const double*)SvPVbyte(x_sv, tl);
636             sm = (double*)SvPVbyte_force(sm_sv, tl);
637              
638             #ifdef _OPENMP
639             #pragma omp parallel for schedule(static) if(use_openmp)
640             #endif
641             for (int i = 0; i < n_pts; i++) {
642             const double *xi = xd + (size_t)i * (size_t)n_feats;
643             int votes = 0;
644             if (min_votes > 0) {
645             double label = 0.0;
646             for (int t = 0; t < n_trees; t++) {
647             if (if_walk_tree(node_ptrs[t], idx_ptrs[t],
648             val_ptrs[t], xi, n_feats) <= depth_cut) {
649             votes++;
650             if (votes >= min_votes) { label = 1.0; break; }
651             }
652             if (votes + (n_trees - 1 - t) < min_votes) break;
653             }
654             sm[i] = label;
655             } else {
656             for (int t = 0; t < n_trees; t++) {
657             votes += (if_walk_tree(node_ptrs[t], idx_ptrs[t],
658             val_ptrs[t], xi, n_feats)
659             <= depth_cut) ? 1 : 0;
660             }
661             sm[i] = (double)votes;
662             }
663             }
664             }
665              
666             /* vote_labels_xs(sm_sv, n_pts, out_rv)
667             *
668             * Converts the 0.0/1.0 label buffer vote_all_xs writes in early-exit
669             * mode into an arrayref of 0/1 IVs -- the majority-voting counterpart
670             * of predict_sums_xs (whose <= comparison points the wrong way for
671             * vote counts, where HIGH means anomalous). */
672             void vote_labels_xs(SV* sm_sv, int n_pts, SV* out_rv){
673             STRLEN tl;
674             const double* sm;
675             AV* out;
676             int i;
677              
678             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
679             croak("vote_labels_xs: out must be an arrayref");
680             }
681             sm = (const double*)SvPVbyte(sm_sv, tl);
682             out = (AV*)SvRV(out_rv);
683             av_clear(out);
684             if (n_pts > 0) av_extend(out, n_pts - 1);
685             for (i = 0; i < n_pts; i++) {
686             av_store(out, i, newSViv(sm[i] != 0.0 ? 1 : 0));
687             }
688             }
689              
690             /* vote_score_predict_xs(sm_sv, n_pts, t, min_votes, out_rv)
691             *
692             * Fills out_rv with [vote_fraction, majority_label] pairs from a
693             * vote-count buffer (vote_all_xs with min_votes == 0): score is
694             * votes/t, label is votes >= min_votes. Same allocation pattern and
695             * refcount discipline as score_predict_xs. */
696             void vote_score_predict_xs(SV* sm_sv, int n_pts, double t,
697             double min_votes, SV* out_rv){
698             STRLEN tl;
699             const double* sm;
700             AV* out;
701             int i;
702              
703             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
704             croak("vote_score_predict_xs: out must be an arrayref");
705             }
706             sm = (const double*)SvPVbyte(sm_sv, tl);
707             out = (AV*)SvRV(out_rv);
708             av_clear(out);
709             if (n_pts > 0) av_extend(out, n_pts - 1);
710             for (i = 0; i < n_pts; i++) {
711             AV* row = newAV();
712             av_extend(row, 1);
713             AvARRAY(row)[0] = newSVnv(sm[i] / t);
714             AvARRAY(row)[1] = newSViv(sm[i] >= min_votes ? 1 : 0);
715             AvFILLp(row) = 1;
716             av_store(out, i, newRV_noinc((SV*)row));
717             }
718             }
719              
720             /* vote_score_predict_split_xs(sm_sv, n_pts, t, min_votes,
721             * scores_rv, labels_rv)
722             *
723             * Parallel-arrays variant of vote_score_predict_xs, mirroring
724             * score_predict_split_xs's shape for the majority-voting path. */
725             void vote_score_predict_split_xs(SV* sm_sv, int n_pts, double t,
726             double min_votes,
727             SV* scores_rv, SV* labels_rv){
728             STRLEN tl;
729             const double* sm;
730             AV* scores;
731             AV* labels;
732             int i;
733              
734             if (!SvROK(scores_rv) || SvTYPE(SvRV(scores_rv)) != SVt_PVAV ||
735             !SvROK(labels_rv) || SvTYPE(SvRV(labels_rv)) != SVt_PVAV) {
736             croak("vote_score_predict_split_xs: scores/labels must be arrayrefs");
737             }
738             sm = (const double*)SvPVbyte(sm_sv, tl);
739             scores = (AV*)SvRV(scores_rv);
740             labels = (AV*)SvRV(labels_rv);
741             av_clear(scores);
742             av_clear(labels);
743             if (n_pts > 0) {
744             av_extend(scores, n_pts - 1);
745             av_extend(labels, n_pts - 1);
746             }
747             for (i = 0; i < n_pts; i++) {
748             av_store(scores, i, newSVnv(sm[i] / t));
749             av_store(labels, i, newSViv(sm[i] >= min_votes ? 1 : 0));
750             }
751             }
752              
753             /* ---------------------------------------------------------------------
754             * build_forest_xs -- C-accelerated fit() tree builder.
755             *
756             * Replaces the pure-Perl _subsample + _build_tree + _axis_split /
757             * _oblique_split recursion with an equivalent C implementation that
758             * partitions plain `int` row-index arrays instead of copying arrayrefs
759             * of Perl SVs at every split. Random draws go through Drand01() --
760             * the exact generator Perl's own rand()/srand() use internally -- in
761             * the same call order the Perl code used, so a fit() with a given
762             * seed produces BIT-IDENTICAL trees whether use_c is on or off. This
763             * is what lets fit() reuse the existing `use_c` knob instead of a new
764             * one: switching backends never changes the model, only how fast it's
765             * built. (Verified by t/02-accel-selection.t's "identical seed =>
766             * identical trees" subtest, which exercises both backends.)
767             *
768             * Output trees are plain Perl arrayrefs in the same node shape
769             * _build_tree produces (leaf/axis/oblique -- see the file-top
770             * comment), so every downstream consumer (_pack_tree, to_json,
771             * from_json, the pure-Perl scorer) is unchanged.
772             *
773             * x_sv: packed row-major double buffer, n_pts rows of n_feats each
774             * (from pack_input_xs -- NaN marks a missing cell under the
775             * 'nan' missing-strategy).
776             * mode_flag: 0 => axis-parallel splits, 1 => oblique (extended).
777             * ext_level: extension_level_used (ignored when mode_flag == 0).
778             * out_rv: pre-existing arrayref; filled with n_trees tree roots.
779             * ------------------------------------------------------------------ */
780              
781             /* Box-Muller normal draw, in the same rand() call order as _randn(). */
782             static double _c_randn(pTHX) {
783             double u1 = Drand01();
784             double u2;
785             if (u1 == 0.0) u1 = 1e-12;
786             u2 = Drand01();
787             return sqrt(-2.0 * log(u1)) * cos(6.283185307179586 * u2);
788             }
789              
790             static SV* _mk_leaf(pTHX_ int size) {
791             AV* av = newAV();
792             av_extend(av, 1);
793             AvARRAY(av)[0] = newSVnv(0.0);
794             AvARRAY(av)[1] = newSViv(size);
795             AvFILLp(av) = 1;
796             return newRV_noinc((SV*)av);
797             }
798              
799             static SV* _mk_axis(pTHX_ int attr, double split, SV* left, SV* right) {
800             AV* av = newAV();
801             av_extend(av, 4);
802             AvARRAY(av)[0] = newSVnv(1.0);
803             AvARRAY(av)[1] = newSViv(attr);
804             AvARRAY(av)[2] = newSVnv(split);
805             AvARRAY(av)[3] = left;
806             AvARRAY(av)[4] = right;
807             AvFILLp(av) = 4;
808             return newRV_noinc((SV*)av);
809             }
810              
811             static SV* _mk_oblique(pTHX_ const int* idx, const double* coef, int n,
812             double b, SV* left, SV* right) {
813             AV *iav, *cav, *av;
814             int k;
815             iav = newAV();
816             cav = newAV();
817             if (n > 0) {
818             av_extend(iav, n - 1);
819             av_extend(cav, n - 1);
820             }
821             for (k = 0; k < n; k++) {
822             AvARRAY(iav)[k] = newSViv(idx[k]);
823             AvARRAY(cav)[k] = newSVnv(coef[k]);
824             }
825             AvFILLp(iav) = n - 1;
826             AvFILLp(cav) = n - 1;
827              
828             av = newAV();
829             av_extend(av, 5);
830             AvARRAY(av)[0] = newSVnv(2.0);
831             AvARRAY(av)[1] = newRV_noinc((SV*)iav);
832             AvARRAY(av)[2] = newRV_noinc((SV*)cav);
833             AvARRAY(av)[3] = newSVnv(b);
834             AvARRAY(av)[4] = left;
835             AvARRAY(av)[5] = right;
836             AvFILLp(av) = 5;
837             return newRV_noinc((SV*)av);
838             }
839              
840             /* Builds one node from the point set `idxs` (row indices into `x`,
841             * length `size`); recurses left-then-right, matching _build_tree's
842             * traversal order so nested splits draw random numbers in the same
843             * sequence the pure-Perl path would. Takes ownership of `idxs` --
844             * frees it before returning. */
845             static SV* _build_node_c(pTHX_ const double* x, int nf, int* idxs, int size,
846             int depth, int limit, int mode_flag,
847             int ext_active) {
848             double *lo, *hi;
849             int *varying, nv, f;
850             SV *result;
851              
852             if (depth >= limit || size <= 1) {
853             SV* leaf = _mk_leaf(aTHX_ size);
854             free(idxs);
855             return leaf;
856             }
857              
858             lo = (double*)malloc(nf * sizeof(double));
859             hi = (double*)malloc(nf * sizeof(double));
860             for (f = 0; f < nf; f++) {
861             lo[f] = HUGE_VAL;
862             hi[f] = -HUGE_VAL;
863             }
864             for (int i = 0; i < size; i++) {
865             const double* row = x + (size_t)idxs[i] * (size_t)nf;
866             /* No isnan() guard needed: NaN < x and NaN > x are always false
867             * under IEEE 754, so a NaN cell (the 'nan' missing strategy)
868             * already leaves lo/hi untouched without an explicit check --
869             * one less branch, and it's what lets this loop vectorize
870             * cleanly as a plain elementwise min/max scan. */
871             #ifdef _OPENMP
872             #pragma omp simd
873             #endif
874             for (int f2 = 0; f2 < nf; f2++) {
875             double v = row[f2];
876             if (v < lo[f2]) lo[f2] = v;
877             if (v > hi[f2]) hi[f2] = v;
878             }
879             }
880              
881             varying = (int*)malloc(nf * sizeof(int));
882             nv = 0;
883             for (f = 0; f < nf; f++) {
884             if (lo[f] < hi[f]) varying[nv++] = f;
885             }
886              
887             if (nv == 0) {
888             free(lo); free(hi); free(varying);
889             SV* leaf = _mk_leaf(aTHX_ size);
890             free(idxs);
891             return leaf;
892             }
893              
894             if (mode_flag == 0) {
895             /* Axis-parallel split: one varying feature, one threshold. */
896             int attr = varying[(int)(Drand01() * nv)];
897             double split = lo[attr] + Drand01() * (hi[attr] - lo[attr]);
898             int *lidx = (int*)malloc(size * sizeof(int));
899             int *ridx = (int*)malloc(size * sizeof(int));
900             int ln = 0, rn = 0, i;
901             SV *left, *right;
902              
903             for (i = 0; i < size; i++) {
904             int row = idxs[i];
905             double v = x[(size_t)row * (size_t)nf + attr];
906             if (v < split) lidx[ln++] = row; else ridx[rn++] = row;
907             }
908             free(idxs); free(lo); free(hi); free(varying);
909              
910             left = _build_node_c(aTHX_ x, nf, lidx, ln, depth + 1, limit,
911             mode_flag, ext_active);
912             right = _build_node_c(aTHX_ x, nf, ridx, rn, depth + 1, limit,
913             mode_flag, ext_active);
914             result = _mk_axis(aTHX_ attr, split, left, right);
915             } else {
916             /* Oblique split: a random hyperplane over `active` features. */
917             int active = ext_active + 1;
918             int *pool, *lidx, *ridx;
919             double *coef;
920             double b = 0.0;
921             int ln = 0, rn = 0, i, k;
922             SV *left, *right;
923              
924             if (active > nv) active = nv;
925             pool = (int*)malloc(nv * sizeof(int));
926             memcpy(pool, varying, nv * sizeof(int));
927             for (i = 0; i < active; i++) {
928             int j = i + (int)(Drand01() * (nv - i));
929             int tmp = pool[i]; pool[i] = pool[j]; pool[j] = tmp;
930             }
931              
932             coef = (double*)malloc(active * sizeof(double));
933             for (k = 0; k < active; k++) {
934             int ff = pool[k];
935             double c = _c_randn(aTHX);
936             double p = lo[ff] + Drand01() * (hi[ff] - lo[ff]);
937             coef[k] = c;
938             b += c * p;
939             }
940              
941             lidx = (int*)malloc(size * sizeof(int));
942             ridx = (int*)malloc(size * sizeof(int));
943             for (i = 0; i < size; i++) {
944             int row = idxs[i];
945             double dot = 0.0;
946             for (k = 0; k < active; k++) {
947             dot += coef[k] * x[(size_t)row * (size_t)nf + pool[k]];
948             }
949             if (dot <= b) lidx[ln++] = row; else ridx[rn++] = row;
950             }
951             free(idxs); free(lo); free(hi); free(varying);
952              
953             left = _build_node_c(aTHX_ x, nf, lidx, ln, depth + 1, limit,
954             mode_flag, ext_active);
955             right = _build_node_c(aTHX_ x, nf, ridx, rn, depth + 1, limit,
956             mode_flag, ext_active);
957             result = _mk_oblique(aTHX_ pool, coef, active, b, left, right);
958             free(pool); free(coef);
959             }
960             return result;
961             }
962              
963             void build_forest_xs(SV* x_sv, int n_pts, int n_feats, int n_trees,
964             int psi, int limit, int mode_flag, int ext_level,
965             SV* out_rv) {
966             dTHX;
967             STRLEN tl;
968             const double* x;
969             AV* out;
970             int* all;
971             int t, i;
972              
973             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
974             croak("build_forest_xs: out must be an arrayref");
975             }
976             x = (const double*)SvPVbyte(x_sv, tl);
977             out = (AV*)SvRV(out_rv);
978             av_clear(out);
979             if (n_trees > 0) av_extend(out, n_trees - 1);
980              
981             all = (int*)malloc(n_pts * sizeof(int));
982             for (t = 0; t < n_trees; t++) {
983             int* sample;
984              
985             for (i = 0; i < n_pts; i++) all[i] = i;
986             for (i = 0; i < psi; i++) {
987             int j = i + (int)(Drand01() * (n_pts - i));
988             int tmp = all[i]; all[i] = all[j]; all[j] = tmp;
989             }
990             sample = (int*)malloc(psi * sizeof(int));
991             memcpy(sample, all, psi * sizeof(int));
992              
993             av_store(out, t,
994             _build_node_c(aTHX_ x, n_feats, sample, psi, 0, limit,
995             mode_flag, ext_level));
996             }
997             free(all);
998             }
999              
1000             /* ---------------------------------------------------------------------
1001             * build_forest_openmp_xs -- OpenMP-parallel fit() tree builder.
1002             *
1003             * build_forest_xs (above) is bit-identical to the pure-Perl path
1004             * because every random draw goes through Drand01(), the same
1005             * generator Perl's rand()/srand() use -- but that generator is a
1006             * single mutable struct shared by the whole interpreter, so calling
1007             * it concurrently from multiple OpenMP threads would be a data race.
1008             * The same is true of any Perl API call (newAV, newSViv, ...): Perl's
1009             * SV allocator isn't safe to call from multiple OS threads sharing one
1010             * interpreter without a lock that would just serialise everything
1011             * anyway.
1012             *
1013             * So this builder trades the bit-identical guarantee for real thread
1014             * parallelism: each tree gets its own splitmix64 PRNG stream, seeded
1015             * from a tree index (not thread id or scheduling order), so results
1016             * are still reproducible for a fixed seed and n_trees regardless of
1017             * OMP_NUM_THREADS -- just different from what build_forest_xs or the
1018             * pure-Perl path would produce for the same seed. The one Drand01()
1019             * call in this function happens before the parallel region starts
1020             * (single-threaded), so the result still varies with the model's
1021             * `seed` the way every other code path does; it isn't used inside the
1022             * parallel loop.
1023             *
1024             * Each tree is built entirely with plain C data (row-index int arrays,
1025             * a growable TreeBuf of packed doubles/ints) -- no Perl API call
1026             * happens anywhere inside the parallel region. Each node record in
1027             * TreeBuf uses _pack_tree's 6-double SoA layout (see the file-top
1028             * comment), but the node ORDER differs: records are appended
1029             * post-order (a node is pushed after both its children, since child
1030             * indices must be known first), so the root is the last record --
1031             * _pack_tree's pre-order puts it at 0. _unpack_forest accounts for
1032             * this. Oblique coefficients are also always stored sparse (in the
1033             * random pool's order) -- the dense-pack fast path is skipped because
1034             * its only purpose is speeding up score_all_xs, and _rebuild_c_trees
1035             * reapplies it anyway once the caller unpacks these buffers back into
1036             * the standard Perl tree shape and re-derives the scoring buffers.
1037             *
1038             * After the parallel region, each tree's TreeBuf is copied into a Perl
1039             * string SV (one memcpy each, serially) and stored into nodes_rv /
1040             * idx_rv / val_rv -- the caller unpacks these into ordinary nested
1041             * Perl trees for $self->{trees} (so to_json/persistence/_rebuild_c_trees
1042             * are unaffected). ------------------------------------------------ */
1043              
1044             typedef struct {
1045             double *nodes; size_t n_nodes, cap_nodes;
1046             int *idx; size_t n_idx, cap_idx;
1047             double *val; size_t n_val, cap_val;
1048             } TreeBuf;
1049              
1050             static void tb_init(TreeBuf *b) {
1051             b->nodes = NULL; b->n_nodes = 0; b->cap_nodes = 0;
1052             b->idx = NULL; b->n_idx = 0; b->cap_idx = 0;
1053             b->val = NULL; b->n_val = 0; b->cap_val = 0;
1054             }
1055              
1056             static void tb_free(TreeBuf *b) {
1057             free(b->nodes); free(b->idx); free(b->val);
1058             }
1059              
1060             static int tb_push_node(TreeBuf *b, double f0, double f1, double f2,
1061             double f3, double f4, double f5) {
1062             double *slot;
1063             if (b->n_nodes == b->cap_nodes) {
1064             size_t newcap = b->cap_nodes ? b->cap_nodes * 2 : 64;
1065             b->nodes = (double*)realloc(b->nodes, newcap * 6 * sizeof(double));
1066             b->cap_nodes = newcap;
1067             }
1068             slot = b->nodes + b->n_nodes * 6;
1069             slot[0] = f0; slot[1] = f1; slot[2] = f2;
1070             slot[3] = f3; slot[4] = f4; slot[5] = f5;
1071             return (int)(b->n_nodes++);
1072             }
1073              
1074             /* Appends n (idx[k], val[k]) pairs and returns the offset they start
1075             * at -- the `coff` an oblique node record stores. */
1076             static int tb_push_coef(TreeBuf *b, const int *idx, const double *val,
1077             int n) {
1078             int off = (int)b->n_idx;
1079             if (b->n_idx + (size_t)n > b->cap_idx) {
1080             size_t newcap = b->cap_idx ? b->cap_idx * 2 : 64;
1081             if (newcap < b->n_idx + (size_t)n) newcap = b->n_idx + (size_t)n;
1082             b->idx = (int*)realloc(b->idx, newcap * sizeof(int));
1083             b->cap_idx = newcap;
1084             }
1085             if (b->n_val + (size_t)n > b->cap_val) {
1086             size_t newcap = b->cap_val ? b->cap_val * 2 : 64;
1087             if (newcap < b->n_val + (size_t)n) newcap = b->n_val + (size_t)n;
1088             b->val = (double*)realloc(b->val, newcap * sizeof(double));
1089             b->cap_val = newcap;
1090             }
1091             memcpy(b->idx + b->n_idx, idx, (size_t)n * sizeof(int));
1092             memcpy(b->val + b->n_val, val, (size_t)n * sizeof(double));
1093             b->n_idx += n;
1094             b->n_val += n;
1095             return off;
1096             }
1097              
1098             /* splitmix64 -- fast, well-mixed, and per-stream state fits in one
1099             * uint64_t, which is all a thread-private PRNG needs here. Not
1100             * cryptographic; doesn't need to be. */
1101             static uint64_t sm64_next(uint64_t *s) {
1102             uint64_t z = (*s += 0x9E3779B97F4A7C15ULL);
1103             z = (z ^ (z >> 30)) * 0xBF58476D1CE4E5B9ULL;
1104             z = (z ^ (z >> 27)) * 0x94D049BB133111EBULL;
1105             return z ^ (z >> 31);
1106             }
1107              
1108             static double sm64_drand(uint64_t *s) {
1109             return (double)(sm64_next(s) >> 11) * (1.0 / 9007199254740992.0);
1110             }
1111              
1112             static double _ts_randn(uint64_t *s) {
1113             double u1 = sm64_drand(s);
1114             double u2;
1115             if (u1 == 0.0) u1 = 1e-12;
1116             u2 = sm64_drand(s);
1117             return sqrt(-2.0 * log(u1)) * cos(6.283185307179586 * u2);
1118             }
1119              
1120             /* Thread-safe twin of _build_node_c: same split algorithm, but reads
1121             * randomness from a thread-private splitmix64 stream instead of
1122             * Drand01(), and writes into a TreeBuf instead of allocating Perl AVs
1123             * -- so it touches no interpreter-global state and is safe to call
1124             * concurrently from an OpenMP parallel region, one tree per thread. */
1125             static int _build_node_packed(const double* x, int nf, int* idxs, int size,
1126             int depth, int limit, int mode_flag,
1127             int ext_active, TreeBuf *buf, uint64_t *rng) {
1128             double *lo, *hi;
1129             int *varying, nv, f, my_idx;
1130              
1131             if (depth >= limit || size <= 1) {
1132             my_idx = tb_push_node(buf, 0.0, (double)size, 0.0, 0.0, 0.0, 0.0);
1133             free(idxs);
1134             return my_idx;
1135             }
1136              
1137             lo = (double*)malloc(nf * sizeof(double));
1138             hi = (double*)malloc(nf * sizeof(double));
1139             for (f = 0; f < nf; f++) {
1140             lo[f] = HUGE_VAL;
1141             hi[f] = -HUGE_VAL;
1142             }
1143             for (int i = 0; i < size; i++) {
1144             const double* row = x + (size_t)idxs[i] * (size_t)nf;
1145             /* See the matching comment in _build_node_c: no isnan() guard
1146             * needed, since NaN < x / NaN > x are always false already --
1147             * that's what lets this vectorize as a plain min/max scan.
1148             * omp simd here is thread-safe to call from inside the caller's
1149             * omp parallel region: it's a per-thread vectorization hint,
1150             * not a team construct, so it doesn't nest into anything. */
1151             #ifdef _OPENMP
1152             #pragma omp simd
1153             #endif
1154             for (int f2 = 0; f2 < nf; f2++) {
1155             double v = row[f2];
1156             if (v < lo[f2]) lo[f2] = v;
1157             if (v > hi[f2]) hi[f2] = v;
1158             }
1159             }
1160              
1161             varying = (int*)malloc(nf * sizeof(int));
1162             nv = 0;
1163             for (f = 0; f < nf; f++) {
1164             if (lo[f] < hi[f]) varying[nv++] = f;
1165             }
1166              
1167             if (nv == 0) {
1168             free(lo); free(hi); free(varying);
1169             my_idx = tb_push_node(buf, 0.0, (double)size, 0.0, 0.0, 0.0, 0.0);
1170             free(idxs);
1171             return my_idx;
1172             }
1173              
1174             if (mode_flag == 0) {
1175             int attr = varying[(int)(sm64_drand(rng) * nv)];
1176             double split = lo[attr] + sm64_drand(rng) * (hi[attr] - lo[attr]);
1177             int *lidx = (int*)malloc(size * sizeof(int));
1178             int *ridx = (int*)malloc(size * sizeof(int));
1179             int ln = 0, rn = 0, i, li, ri;
1180              
1181             for (i = 0; i < size; i++) {
1182             int row = idxs[i];
1183             double v = x[(size_t)row * (size_t)nf + attr];
1184             if (v < split) lidx[ln++] = row; else ridx[rn++] = row;
1185             }
1186             free(idxs); free(lo); free(hi); free(varying);
1187              
1188             li = _build_node_packed(x, nf, lidx, ln, depth + 1, limit,
1189             mode_flag, ext_active, buf, rng);
1190             ri = _build_node_packed(x, nf, ridx, rn, depth + 1, limit,
1191             mode_flag, ext_active, buf, rng);
1192             my_idx = tb_push_node(buf, 1.0, (double)attr, split,
1193             (double)li, (double)ri, 0.0);
1194             } else {
1195             int active = ext_active + 1;
1196             int *pool, *lidx, *ridx;
1197             double *coef;
1198             double b = 0.0;
1199             int ln = 0, rn = 0, i, k, li, ri, coff;
1200              
1201             if (active > nv) active = nv;
1202             pool = (int*)malloc(nv * sizeof(int));
1203             memcpy(pool, varying, nv * sizeof(int));
1204             for (i = 0; i < active; i++) {
1205             int j = i + (int)(sm64_drand(rng) * (nv - i));
1206             int tmp = pool[i]; pool[i] = pool[j]; pool[j] = tmp;
1207             }
1208              
1209             coef = (double*)malloc(active * sizeof(double));
1210             for (k = 0; k < active; k++) {
1211             int ff = pool[k];
1212             double c = _ts_randn(rng);
1213             double p = lo[ff] + sm64_drand(rng) * (hi[ff] - lo[ff]);
1214             coef[k] = c;
1215             b += c * p;
1216             }
1217              
1218             lidx = (int*)malloc(size * sizeof(int));
1219             ridx = (int*)malloc(size * sizeof(int));
1220             for (i = 0; i < size; i++) {
1221             int row = idxs[i];
1222             double dot = 0.0;
1223             for (k = 0; k < active; k++) {
1224             dot += coef[k] * x[(size_t)row * (size_t)nf + pool[k]];
1225             }
1226             if (dot <= b) lidx[ln++] = row; else ridx[rn++] = row;
1227             }
1228             free(idxs); free(lo); free(hi); free(varying);
1229              
1230             li = _build_node_packed(x, nf, lidx, ln, depth + 1, limit,
1231             mode_flag, ext_active, buf, rng);
1232             ri = _build_node_packed(x, nf, ridx, rn, depth + 1, limit,
1233             mode_flag, ext_active, buf, rng);
1234             coff = tb_push_coef(buf, pool, coef, active);
1235             my_idx = tb_push_node(buf, 2.0, (double)coff, (double)active,
1236             (double)li, (double)ri, b);
1237             free(pool); free(coef);
1238             }
1239             return my_idx;
1240             }
1241              
1242             void build_forest_openmp_xs(SV* x_sv, int n_pts, int n_feats, int n_trees,
1243             int psi, int limit, int mode_flag,
1244             int ext_level, SV* nodes_rv, SV* idx_rv,
1245             SV* val_rv, int use_openmp) {
1246             dTHX;
1247             STRLEN tl;
1248             const double* x;
1249             AV *nodes_av, *idx_av, *val_av;
1250             TreeBuf *bufs;
1251             uint64_t base_seed;
1252             int t;
1253              
1254             if (!SvROK(nodes_rv) || SvTYPE(SvRV(nodes_rv)) != SVt_PVAV ||
1255             !SvROK(idx_rv) || SvTYPE(SvRV(idx_rv)) != SVt_PVAV ||
1256             !SvROK(val_rv) || SvTYPE(SvRV(val_rv)) != SVt_PVAV) {
1257             croak("build_forest_openmp_xs: nodes/idx/val must be arrayrefs");
1258             }
1259             x = (const double*)SvPVbyte(x_sv, tl);
1260             nodes_av = (AV*)SvRV(nodes_rv);
1261             idx_av = (AV*)SvRV(idx_rv);
1262             val_av = (AV*)SvRV(val_rv);
1263             av_clear(nodes_av); av_clear(idx_av); av_clear(val_av);
1264             if (n_trees > 0) {
1265             av_extend(nodes_av, n_trees - 1);
1266             av_extend(idx_av, n_trees - 1);
1267             av_extend(val_av, n_trees - 1);
1268             }
1269              
1270             /* Single Drand01() call, before the parallel region starts, so it's
1271             * still a plain serial call into the interpreter's RNG state. */
1272             base_seed = (uint64_t)(Drand01() * 18446744073709551615.0);
1273              
1274             bufs = (TreeBuf*)malloc((size_t)n_trees * sizeof(TreeBuf));
1275             for (t = 0; t < n_trees; t++) tb_init(&bufs[t]);
1276              
1277             #ifdef _OPENMP
1278             #pragma omp parallel for schedule(dynamic) if(use_openmp)
1279             #endif
1280             for (int t = 0; t < n_trees; t++) {
1281             /* Seeded from the tree index, not thread id or iteration order,
1282             * so the mapping from tree -> RNG stream is independent of
1283             * OMP_NUM_THREADS / scheduling. sm64_next() mixes once more so
1284             * adjacent tree indices (which differ by one golden-ratio step)
1285             * don't start from too-similar states. */
1286             uint64_t rng = base_seed + (uint64_t)t * 0x9E3779B97F4A7C15ULL;
1287             rng = sm64_next(&rng);
1288             int *all = (int*)malloc((size_t)n_pts * sizeof(int));
1289             int *sample;
1290             int i;
1291              
1292             for (i = 0; i < n_pts; i++) all[i] = i;
1293             for (i = 0; i < psi; i++) {
1294             int j = i + (int)(sm64_drand(&rng) * (n_pts - i));
1295             int tmp = all[i]; all[i] = all[j]; all[j] = tmp;
1296             }
1297             sample = (int*)malloc((size_t)psi * sizeof(int));
1298             memcpy(sample, all, (size_t)psi * sizeof(int));
1299             free(all);
1300              
1301             _build_node_packed(x, n_feats, sample, psi, 0, limit, mode_flag,
1302             ext_level, &bufs[t], &rng);
1303             }
1304              
1305             for (t = 0; t < n_trees; t++) {
1306             /* newSVpvn(NULL, 0) makes an undef SV, not an empty-string one --
1307             * axis-mode trees never call tb_push_coef, so idx/val stay NULL.
1308             * Pass "" instead so the Perl side's unpack('...', $sv) always
1309             * gets a defined (if empty) string, never undef. */
1310             av_store(nodes_av, t, newSVpvn((char*)bufs[t].nodes,
1311             bufs[t].n_nodes * 6 * sizeof(double)));
1312             av_store(idx_av, t, bufs[t].n_idx
1313             ? newSVpvn((char*)bufs[t].idx, bufs[t].n_idx * sizeof(int))
1314             : newSVpvn("", 0));
1315             av_store(val_av, t, bufs[t].n_val
1316             ? newSVpvn((char*)bufs[t].val, bufs[t].n_val * sizeof(double))
1317             : newSVpvn("", 0));
1318             tb_free(&bufs[t]);
1319             }
1320             free(bufs);
1321             }
1322              
1323             /* ---------------------------------------------------------------------
1324             * impute_fill_xs(data_sv, n_pts, n_feats, how, out_rv)
1325             *
1326             * C replacement for _compute_impute_fill's Perl loop: walks the raw
1327             * arrayref-of-arrayrefs directly (like pack_input_xs), collecting each
1328             * feature's present (defined) values, then reduces them to one fill
1329             * value per feature -- mean (how == 0) or median (how == 1) -- and
1330             * writes n_feats doubles into out_rv.
1331             *
1332             * Values are collected in row order (i = 0..n_pts-1), the same order
1333             * the Perl version's `grep { defined } map { $_->[$f] } @data` walks
1334             * them in, so the mean's left-to-right summation lands on the exact
1335             * same float as the Perl path -- use_c toggles speed here, not the
1336             * computed fill, matching the rest of the module.
1337             *
1338             * The median is an exact order statistic (not summation-dependent), so
1339             * it matches the Perl path's sort-based median by definition regardless
1340             * of which selection algorithm finds it. Croaks with the same message
1341             * as the Perl fallback if a feature has no present values anywhere in
1342             * the dataset. */
1343             typedef struct { double *v; size_t n, cap; } DVec;
1344              
1345             static void dvec_push(DVec *d, double x) {
1346             if (d->n == d->cap) {
1347             size_t newcap = d->cap ? d->cap * 2 : 64;
1348             d->v = (double*)realloc(d->v, newcap * sizeof(double));
1349             d->cap = newcap;
1350             }
1351             d->v[d->n++] = x;
1352             }
1353              
1354             static void _dswap(double *a, double *b) { double t = *a; *a = *b; *b = t; }
1355              
1356             /* Lomuto partition with a median-of-three pivot (avoids the O(n^2)
1357             * worst case a fixed pivot hits on already-sorted or reverse-sorted
1358             * input, which real feature columns -- timestamps, counters -- often
1359             * are). Returns the pivot's final index. */
1360             static int _partition_lomuto(double *a, int lo, int hi) {
1361             int mid = lo + (hi - lo) / 2;
1362             double pivot;
1363             int i, j;
1364             if (a[mid] < a[lo]) _dswap(&a[lo], &a[mid]);
1365             if (a[hi] < a[lo]) _dswap(&a[lo], &a[hi]);
1366             if (a[hi] < a[mid]) _dswap(&a[mid], &a[hi]);
1367             _dswap(&a[mid], &a[hi]);
1368             pivot = a[hi];
1369             i = lo;
1370             for (j = lo; j < hi; j++) {
1371             if (a[j] < pivot) { _dswap(&a[i], &a[j]); i++; }
1372             }
1373             _dswap(&a[i], &a[hi]);
1374             return i;
1375             }
1376              
1377             /* Quickselect: returns the k-th smallest (0-indexed) of a[0..n-1],
1378             * reordering a[] in the process (fine -- it's a private scratch copy).
1379             * O(n) average case vs. a full O(n log n) sort. */
1380             static double _kth_smallest(double *a, int n, int k) {
1381             int lo = 0, hi = n - 1;
1382             while (lo < hi) {
1383             int p = _partition_lomuto(a, lo, hi);
1384             if (p == k) return a[p];
1385             if (p < k) lo = p + 1; else hi = p - 1;
1386             }
1387             return a[lo];
1388             }
1389              
1390             /* Median of a[0..n-1] (reorders a[]). Odd n: the single middle order
1391             * statistic. Even n: quickselect finds the lower-median at k = n/2-1,
1392             * which leaves every a[i > k] >= a[k] (the standard quickselect
1393             * post-condition) -- so the upper-median is just the min of that
1394             * remaining slice, one more linear scan instead of a second full
1395             * selection pass. */
1396             static double _median_select(double *a, int n) {
1397             if (n % 2 == 1) {
1398             return _kth_smallest(a, n, n / 2);
1399             } else {
1400             int k = n / 2 - 1;
1401             double lower = _kth_smallest(a, n, k);
1402             double upper = a[k + 1];
1403             int i;
1404             for (i = k + 2; i < n; i++) {
1405             if (a[i] < upper) upper = a[i];
1406             }
1407             return (lower + upper) / 2.0;
1408             }
1409             }
1410              
1411             void impute_fill_xs(SV* data_sv, int n_pts, int n_feats, int how,
1412             SV* out_rv) {
1413             dTHX;
1414             AV *outer, *out;
1415             DVec *cols;
1416             int i, f;
1417              
1418             if (!SvROK(data_sv) || SvTYPE(SvRV(data_sv)) != SVt_PVAV) {
1419             croak("impute_fill_xs: data must be an arrayref");
1420             }
1421             if (!SvROK(out_rv) || SvTYPE(SvRV(out_rv)) != SVt_PVAV) {
1422             croak("impute_fill_xs: out must be an arrayref");
1423             }
1424             outer = (AV*)SvRV(data_sv);
1425             out = (AV*)SvRV(out_rv);
1426              
1427             cols = (DVec*)calloc((size_t)n_feats, sizeof(DVec));
1428              
1429             for (i = 0; i < n_pts; i++) {
1430             SV** row_pp = av_fetch(outer, i, 0);
1431             AV* row;
1432             if (!row_pp || !*row_pp || !SvROK(*row_pp) ||
1433             SvTYPE(SvRV(*row_pp)) != SVt_PVAV) {
1434             continue;
1435             }
1436             row = (AV*)SvRV(*row_pp);
1437             for (f = 0; f < n_feats; f++) {
1438             SV** v = av_fetch(row, f, 0);
1439             if (v && *v && SvOK(*v)) {
1440             dvec_push(&cols[f], SvNV(*v));
1441             }
1442             }
1443             }
1444              
1445             /* Validate every column before freeing anything: croak() longjmps
1446             * out of this function, so any cleanup loop reachable after a
1447             * partial computation has already started (and already freed some
1448             * cols[i].v) risks a double free on those same pointers. Checking
1449             * all columns up front, before the computation loop below frees
1450             * anything, avoids that entirely. Matches the Perl fallback's
1451             * behaviour of reporting the first empty column in feature order. */
1452             for (f = 0; f < n_feats; f++) {
1453             if (cols[f].n == 0) {
1454             int col = f;
1455             for (i = 0; i < n_feats; i++) free(cols[i].v);
1456             free(cols);
1457             croak("impute: feature column %d has no present values", col);
1458             }
1459             }
1460              
1461             av_clear(out);
1462             if (n_feats > 0) av_extend(out, n_feats - 1);
1463              
1464             for (f = 0; f < n_feats; f++) {
1465             double result;
1466             if (how == 0) {
1467             double sum = 0.0;
1468             for (i = 0; i < (int)cols[f].n; i++) sum += cols[f].v[i];
1469             result = sum / (double)cols[f].n;
1470             } else {
1471             result = _median_select(cols[f].v, (int)cols[f].n);
1472             }
1473             av_store(out, f, newSVnv(result));
1474             free(cols[f].v);
1475             }
1476             free(cols);
1477             }
1478              
1479             /* ---------------------------------------------------------------------
1480             * Online Isolation Forest (Algorithm::Classifier::IsolationForest::
1481             * Online) learn / unlearn / score-row accelerators.
1482             *
1483             * Unlike everything above, these operate directly on LIVE Perl
1484             * arrayref trees: online trees mutate on every learned point, so there
1485             * is no immutable packed form to walk during learning. Node layout
1486             * (Online.pm's _N_* constants):
1487             *
1488             * leaf: [0, count, \@lo, \@hi]
1489             * internal: [1, count, \@lo, \@hi, attr, split, left, right]
1490             *
1491             * and a tree record is a hashref { root, count, depth_limit }; root is
1492             * undef until the tree learns its first point, and a leaf built from an
1493             * empty synthetic partition has undef lo/hi until a real point reaches
1494             * it.
1495             *
1496             * Random draws go through Drand01() in EXACTLY the order the pure-Perl
1497             * learn path calls rand(): an optional per-tree subsample gate (drawn
1498             * only when subsample < 1), and -- only when a leaf splits --
1499             * count * nf box-sample draws that SKIP zero-width features (the Perl
1500             * _sample_box never draws for those), then per synthetic internal node
1501             * one draw for the split feature and one for the split value, recursing
1502             * left before right. A learn() with a given seed therefore produces
1503             * BIT-IDENTICAL trees whether use_c is on or off (on nvsize == 8 perls;
1504             * wide-NV perls keep extra low bits in the pure-Perl path, as with
1505             * fit()), which is what lets the online class reuse the existing use_c
1506             * knob for learning instead of growing a new one.
1507             * ------------------------------------------------------------------ */
1508              
1509             #define OL_TYPE 0
1510             #define OL_COUNT 1
1511             #define OL_LO 2
1512             #define OL_HI 3
1513             #define OL_ATTR 4
1514             #define OL_SPLIT 5
1515             #define OL_LEFT 6
1516             #define OL_RIGHT 7
1517              
1518             /* ln(4) as the exact double Perl's compile-time log(4) produces --
1519             * spelled as a literal (like TWO_PI on the Perl side) so a compiler
1520             * that constant-folds log(4.0) differently from libm cannot introduce
1521             * a one-ulp parity break in the depth budget. */
1522             #define OL_LOG4 1.3862943611198906
1523              
1524             /* Depth budget for n points -- the C image of Online.pm's _rpl(). */
1525             static double _ol_rpl(double n, int eta) {
1526             if (n < (double)eta) return 0.0;
1527             return log(n / (double)eta) / OL_LOG4;
1528             }
1529              
1530             /* Points a node at `depth` needs before it may split (below which, on
1531             * forgetting, it collapses back into a leaf) -- _split_threshold().
1532             * ldexp keeps the adaptive 2**depth factor exact, matching Perl's
1533             * NV exponentiation. */
1534             static double _ol_split_threshold(int eta, int adaptive, int depth) {
1535             return (double)eta * (adaptive ? ldexp(1.0, depth) : 1.0);
1536             }
1537              
1538             /* Fresh [v0 .. v(nf-1)] arrayref (a bounding-box side). */
1539             static SV* _ol_mk_box(pTHX_ const double* v, int nf) {
1540             AV* av = newAV();
1541             int k;
1542             av_extend(av, nf - 1);
1543             for (k = 0; k < nf; k++) AvARRAY(av)[k] = newSVnv(v[k]);
1544             AvFILLp(av) = nf - 1;
1545             return newRV_noinc((SV*)av);
1546             }
1547              
1548             /* lo_rv/hi_rv may be NULL => undef box (leaf from an empty synthetic
1549             * partition). Takes ownership of non-NULL refs. */
1550             static SV* _ol_mk_leaf(pTHX_ IV count, SV* lo_rv, SV* hi_rv) {
1551             AV* av = newAV();
1552             av_extend(av, 3);
1553             AvARRAY(av)[0] = newSViv(0);
1554             AvARRAY(av)[1] = newSViv(count);
1555             AvARRAY(av)[2] = lo_rv ? lo_rv : &PL_sv_undef;
1556             AvARRAY(av)[3] = hi_rv ? hi_rv : &PL_sv_undef;
1557             AvFILLp(av) = 3;
1558             return newRV_noinc((SV*)av);
1559             }
1560              
1561             static SV* _ol_mk_axis(pTHX_ IV count, SV* lo_rv, SV* hi_rv, int attr,
1562             double split, SV* left, SV* right) {
1563             AV* av = newAV();
1564             av_extend(av, 7);
1565             AvARRAY(av)[0] = newSViv(1);
1566             AvARRAY(av)[1] = newSViv(count);
1567             AvARRAY(av)[2] = lo_rv;
1568             AvARRAY(av)[3] = hi_rv;
1569             AvARRAY(av)[4] = newSViv(attr);
1570             AvARRAY(av)[5] = newSVnv(split);
1571             AvARRAY(av)[6] = left;
1572             AvARRAY(av)[7] = right;
1573             AvFILLp(av) = 7;
1574             return newRV_noinc((SV*)av);
1575             }
1576              
1577             /* Recursively build a subtree over synthetic points (row indices into
1578             * pts, a rows x nf buffer) -- the C image of _build_from_points(), in
1579             * the same draw order: split feature, split value, left subtree, right
1580             * subtree. The partition is stable, matching the Perl push loop. */
1581             static SV* _ol_build(pTHX_ const double* pts, const int* idx, int n, int nf,
1582             int depth, double limit, int eta, int adaptive) {
1583             SV *lo_rv = NULL, *hi_rv = NULL;
1584             int i, f;
1585              
1586             if (n > 0) {
1587             double* lo = (double*)malloc(nf * sizeof(double));
1588             double* hi = (double*)malloc(nf * sizeof(double));
1589             const double* p0 = pts + (size_t)idx[0] * (size_t)nf;
1590             for (f = 0; f < nf; f++) { lo[f] = p0[f]; hi[f] = p0[f]; }
1591             for (i = 0; i < n; i++) {
1592             const double* p = pts + (size_t)idx[i] * (size_t)nf;
1593             for (f = 0; f < nf; f++) {
1594             if (p[f] < lo[f]) lo[f] = p[f];
1595             if (p[f] > hi[f]) hi[f] = p[f];
1596             }
1597             }
1598             lo_rv = _ol_mk_box(aTHX_ lo, nf);
1599             hi_rv = _ol_mk_box(aTHX_ hi, nf);
1600             free(lo);
1601             free(hi);
1602             }
1603              
1604             if ((double)n < _ol_split_threshold(eta, adaptive, depth) ||
1605             (double)depth >= limit) {
1606             return _ol_mk_leaf(aTHX_ (IV)n, lo_rv, hi_rv);
1607             }
1608              
1609             {
1610             int attr = (int)(Drand01() * nf);
1611             double pmin = pts[(size_t)idx[0] * (size_t)nf + attr];
1612             double pmax = pmin;
1613             double split;
1614             int *l, *r, ln = 0, rn = 0;
1615             SV *left, *right;
1616              
1617             for (i = 0; i < n; i++) {
1618             double v = pts[(size_t)idx[i] * (size_t)nf + attr];
1619             if (v < pmin) pmin = v;
1620             if (v > pmax) pmax = v;
1621             }
1622             split = pmin + Drand01() * (pmax - pmin);
1623              
1624             l = (int*)malloc(n * sizeof(int));
1625             r = (int*)malloc(n * sizeof(int));
1626             for (i = 0; i < n; i++) {
1627             if (pts[(size_t)idx[i] * (size_t)nf + attr] < split) l[ln++] = idx[i];
1628             else r[rn++] = idx[i];
1629             }
1630             left = _ol_build(aTHX_ pts, l, ln, nf, depth + 1, limit, eta, adaptive);
1631             right = _ol_build(aTHX_ pts, r, rn, nf, depth + 1, limit, eta, adaptive);
1632             free(l);
1633             free(r);
1634             return _ol_mk_axis(aTHX_ (IV)n, lo_rv, hi_rv, attr, split, left, right);
1635             }
1636             }
1637              
1638             /* Route one point down, growing counts and boxes -- _node_learn().
1639             * Returns the (possibly replaced) node ref; a changed return is stored
1640             * back by the caller, exactly like the Perl recursion's assignment.
1641             * When a leaf is replaced by a freshly built subtree the return value
1642             * is a new ref with refcount 1 and the caller's store drops the old
1643             * leaf's reference. */
1644             static SV* _ol_node_learn(pTHX_ SV* node_rv, const double* x, int nf,
1645             int depth, double limit, int eta, int adaptive) {
1646             AV* node = (AV*)SvRV(node_rv);
1647             SV** slots = AvARRAY(node);
1648             IV count = SvIV(slots[OL_COUNT]) + 1;
1649             int f;
1650              
1651             sv_setiv(slots[OL_COUNT], count);
1652              
1653             if (!SvOK(slots[OL_LO])) {
1654             /* Leaf born from an empty synthetic partition: the first real
1655             * point initialises the box. */
1656             av_store(node, OL_LO, _ol_mk_box(aTHX_ x, nf));
1657             av_store(node, OL_HI, _ol_mk_box(aTHX_ x, nf));
1658             slots = AvARRAY(node);
1659             } else {
1660             AV* lo = (AV*)SvRV(slots[OL_LO]);
1661             AV* hi = (AV*)SvRV(slots[OL_HI]);
1662             for (f = 0; f < nf; f++) {
1663             SV** lv = av_fetch(lo, f, 1);
1664             SV** hv = av_fetch(hi, f, 1);
1665             if (x[f] < SvNV(*lv)) sv_setnv(*lv, x[f]);
1666             if (x[f] > SvNV(*hv)) sv_setnv(*hv, x[f]);
1667             }
1668             }
1669              
1670             if (SvIV(slots[OL_TYPE]) == 0) { /* leaf */
1671             if ((double)count >= _ol_split_threshold(eta, adaptive, depth) &&
1672             (double)depth < limit) {
1673             AV* lo = (AV*)SvRV(AvARRAY(node)[OL_LO]);
1674             AV* hi = (AV*)SvRV(AvARRAY(node)[OL_HI]);
1675             double* lod = (double*)malloc(nf * sizeof(double));
1676             double* hid = (double*)malloc(nf * sizeof(double));
1677             double* pts = (double*)malloc((size_t)count * (size_t)nf * sizeof(double));
1678             int* idx = (int*)malloc((size_t)count * sizeof(int));
1679             SV* subtree;
1680             int i;
1681              
1682             for (f = 0; f < nf; f++) {
1683             SV** lv = av_fetch(lo, f, 0);
1684             SV** hv = av_fetch(hi, f, 0);
1685             lod[f] = (lv && *lv && SvOK(*lv)) ? SvNV(*lv) : 0.0;
1686             hid[f] = (hv && *hv && SvOK(*hv)) ? SvNV(*hv) : 0.0;
1687             }
1688             /* Synthetic points, point-major, one draw per feature with
1689             * width > 0 -- _sample_box's exact draw order. */
1690             for (i = 0; i < (int)count; i++) {
1691             for (f = 0; f < nf; f++) {
1692             double w = hid[f] - lod[f];
1693             pts[(size_t)i * (size_t)nf + f]
1694             = (w > 0) ? lod[f] + Drand01() * w : lod[f];
1695             }
1696             idx[i] = i;
1697             }
1698             subtree = _ol_build(aTHX_ pts, idx, (int)count, nf, depth, limit,
1699             eta, adaptive);
1700             free(lod);
1701             free(hid);
1702             free(pts);
1703             free(idx);
1704             return subtree;
1705             }
1706             return node_rv;
1707             }
1708              
1709             {
1710             int attr = (int)SvIV(slots[OL_ATTR]);
1711             double split = SvNV(slots[OL_SPLIT]);
1712             int ci = (x[attr] < split) ? OL_LEFT : OL_RIGHT;
1713             SV* child = AvARRAY(node)[ci];
1714             SV* nc = _ol_node_learn(aTHX_ child, x, nf, depth + 1, limit, eta,
1715             adaptive);
1716             if (nc != child) av_store(node, ci, nc);
1717             return node_rv;
1718             }
1719             }
1720              
1721             /* Union of two nodes' boxes into caller-provided arrays, matching
1722             * _box_union(): nodes without a box are skipped, the first boxed node
1723             * is copied and the second folded in. Returns 0 when neither node has
1724             * a box. */
1725             static int _ol_box_union(pTHX_ SV* a_rv, SV* b_rv, int nf,
1726             double* lo, double* hi) {
1727             SV* boxed[2];
1728             int nb = 0, bi, f;
1729              
1730             if (SvOK(AvARRAY((AV*)SvRV(a_rv))[OL_LO])) boxed[nb++] = a_rv;
1731             if (SvOK(AvARRAY((AV*)SvRV(b_rv))[OL_LO])) boxed[nb++] = b_rv;
1732             if (nb == 0) return 0;
1733              
1734             for (bi = 0; bi < nb; bi++) {
1735             AV* node = (AV*)SvRV(boxed[bi]);
1736             AV* blo = (AV*)SvRV(AvARRAY(node)[OL_LO]);
1737             AV* bhi = (AV*)SvRV(AvARRAY(node)[OL_HI]);
1738             for (f = 0; f < nf; f++) {
1739             SV** lv = av_fetch(blo, f, 0);
1740             SV** hv = av_fetch(bhi, f, 0);
1741             double l = (lv && *lv && SvOK(*lv)) ? SvNV(*lv) : 0.0;
1742             double h = (hv && *hv && SvOK(*hv)) ? SvNV(*hv) : 0.0;
1743             if (bi == 0) {
1744             lo[f] = l;
1745             hi[f] = h;
1746             } else {
1747             if (l < lo[f]) lo[f] = l;
1748             if (h > hi[f]) hi[f] = h;
1749             }
1750             }
1751             }
1752             return 1;
1753             }
1754              
1755             /* Aggregate a subtree back into one leaf -- _collapse(). Children are
1756             * collapsed first so their boxes can be unioned; intermediate leaves
1757             * built while collapsing internal children are temporaries and dropped
1758             * here. Returns a NEW leaf ref (refcount 1) for internal nodes, or the
1759             * node itself when it is already a leaf. */
1760             static SV* _ol_collapse(pTHX_ SV* node_rv, int nf) {
1761             AV* node = (AV*)SvRV(node_rv);
1762             SV *l_rv, *r_rv, *cl, *cr, *leaf;
1763             SV *lo_rv = NULL, *hi_rv = NULL;
1764             double *lo, *hi;
1765              
1766             if (SvIV(AvARRAY(node)[OL_TYPE]) == 0) return node_rv;
1767              
1768             l_rv = AvARRAY(node)[OL_LEFT];
1769             r_rv = AvARRAY(node)[OL_RIGHT];
1770             cl = _ol_collapse(aTHX_ l_rv, nf);
1771             cr = _ol_collapse(aTHX_ r_rv, nf);
1772              
1773             lo = (double*)malloc(nf * sizeof(double));
1774             hi = (double*)malloc(nf * sizeof(double));
1775             if (_ol_box_union(aTHX_ cl, cr, nf, lo, hi)) {
1776             lo_rv = _ol_mk_box(aTHX_ lo, nf);
1777             hi_rv = _ol_mk_box(aTHX_ hi, nf);
1778             } else if (SvOK(AvARRAY(node)[OL_LO])) {
1779             /* Both children boxless: keep the node's own box (the Perl code
1780             * moves the same arrayrefs into the new leaf). */
1781             lo_rv = SvREFCNT_inc(AvARRAY(node)[OL_LO]);
1782             hi_rv = SvREFCNT_inc(AvARRAY(node)[OL_HI]);
1783             }
1784             free(lo);
1785             free(hi);
1786              
1787             leaf = _ol_mk_leaf(aTHX_ SvIV(AvARRAY(node)[OL_COUNT]), lo_rv, hi_rv);
1788             if (cl != l_rv) SvREFCNT_dec(cl);
1789             if (cr != r_rv) SvREFCNT_dec(cr);
1790             return leaf;
1791             }
1792              
1793             /* Route the forgotten point down, decrementing counts -- _node_unlearn().
1794             * An internal node whose count no longer justifies its split collapses;
1795             * otherwise its box is refreshed to the union of its children's. */
1796             static SV* _ol_node_unlearn(pTHX_ SV* node_rv, const double* x, int nf,
1797             int depth, int eta, int adaptive) {
1798             AV* node = (AV*)SvRV(node_rv);
1799             SV** slots = AvARRAY(node);
1800             IV count = SvIV(slots[OL_COUNT]) - 1;
1801              
1802             sv_setiv(slots[OL_COUNT], count);
1803              
1804             if (SvIV(slots[OL_TYPE]) == 0) return node_rv;
1805             if ((double)count < _ol_split_threshold(eta, adaptive, depth)) {
1806             return _ol_collapse(aTHX_ node_rv, nf);
1807             }
1808              
1809             {
1810             int attr = (int)SvIV(slots[OL_ATTR]);
1811             double split = SvNV(slots[OL_SPLIT]);
1812             int ci = (x[attr] < split) ? OL_LEFT : OL_RIGHT;
1813             SV* child = AvARRAY(node)[ci];
1814             double *lo, *hi;
1815             SV* nc = _ol_node_unlearn(aTHX_ child, x, nf, depth + 1, eta,
1816             adaptive);
1817             if (nc != child) av_store(node, ci, nc);
1818              
1819             lo = (double*)malloc(nf * sizeof(double));
1820             hi = (double*)malloc(nf * sizeof(double));
1821             if (_ol_box_union(aTHX_ AvARRAY(node)[OL_LEFT],
1822             AvARRAY(node)[OL_RIGHT], nf, lo, hi)) {
1823             av_store(node, OL_LO, _ol_mk_box(aTHX_ lo, nf));
1824             av_store(node, OL_HI, _ol_mk_box(aTHX_ hi, nf));
1825             }
1826             free(lo);
1827             free(hi);
1828             return node_rv;
1829             }
1830             }
1831              
1832             /* Read one sample row (arrayref) into a dense double buffer; undef -> 0,
1833             * matching the pure-Perl paths (learn rows are pre-densified anyway). */
1834             static void _ol_read_row(pTHX_ SV* row_sv, double* x, int nf) {
1835             AV* row;
1836             int f;
1837             if (!SvROK(row_sv) || SvTYPE(SvRV(row_sv)) != SVt_PVAV)
1838             croak("online row must be an arrayref");
1839             row = (AV*)SvRV(row_sv);
1840             for (f = 0; f < nf; f++) {
1841             SV** v = av_fetch(row, f, 0);
1842             x[f] = (v && *v && SvOK(*v)) ? SvNV(*v) : 0.0;
1843             }
1844             }
1845              
1846             /* Fetch tree t of the trees arrayref as its underlying HV. */
1847             static HV* _ol_tree_hv(pTHX_ AV* trees, int t) {
1848             SV** tp = av_fetch(trees, t, 0);
1849             if (!tp || !*tp || !SvROK(*tp) || SvTYPE(SvRV(*tp)) != SVt_PVHV)
1850             croak("online tree %d is not a hashref", t);
1851             return (HV*)SvRV(*tp);
1852             }
1853              
1854             /* online_learn_row_xs(trees_av, row_av, nf, eta, adaptive, subsample)
1855             *
1856             * The C image of _learn_row's per-tree loop: every tree (subject to the
1857             * subsample gate) learns the row, with count / depth_limit bookkeeping
1858             * on the tree hash. Mutates the live trees in place. */
1859             void online_learn_row_xs(SV* trees_av_sv, SV* row_sv, int nf, int eta,
1860             int adaptive, double subsample) {
1861             dTHX;
1862             AV* trees;
1863             double* x;
1864             int t, n_trees;
1865              
1866             if (!SvROK(trees_av_sv) || SvTYPE(SvRV(trees_av_sv)) != SVt_PVAV)
1867             croak("online_learn_row_xs: trees must be an arrayref");
1868             trees = (AV*)SvRV(trees_av_sv);
1869             n_trees = (int)av_len(trees) + 1;
1870              
1871             x = (double*)malloc(nf * sizeof(double));
1872             _ol_read_row(aTHX_ row_sv, x, nf);
1873              
1874             for (t = 0; t < n_trees; t++) {
1875             HV* tree;
1876             SV **csv, **dsv, **rsv;
1877             IV count;
1878             double limit;
1879              
1880             if (subsample < 1.0 && Drand01() >= subsample) continue;
1881             tree = _ol_tree_hv(aTHX_ trees, t);
1882              
1883             csv = hv_fetch(tree, "count", 5, 1);
1884             count = (SvOK(*csv) ? SvIV(*csv) : 0) + 1;
1885             sv_setiv(*csv, count);
1886             limit = _ol_rpl((double)count, eta);
1887             dsv = hv_fetch(tree, "depth_limit", 11, 1);
1888             sv_setnv(*dsv, limit);
1889              
1890             rsv = hv_fetch(tree, "root", 4, 1);
1891             if (!SvOK(*rsv)) {
1892             (void)hv_store(tree, "root", 4,
1893             _ol_mk_leaf(aTHX_ 1, _ol_mk_box(aTHX_ x, nf),
1894             _ol_mk_box(aTHX_ x, nf)), 0);
1895             } else {
1896             SV* root = *rsv;
1897             SV* nr = _ol_node_learn(aTHX_ root, x, nf, 0, limit, eta,
1898             adaptive);
1899             if (nr != root) (void)hv_store(tree, "root", 4, nr, 0);
1900             }
1901             }
1902             free(x);
1903             }
1904              
1905             /* online_unlearn_row_xs(trees_av, row_av, nf, eta, adaptive, subsample)
1906             *
1907             * The C image of _learn_row's eviction loop (_tree_unlearn per tree,
1908             * behind the same independent subsample gate). */
1909             void online_unlearn_row_xs(SV* trees_av_sv, SV* row_sv, int nf, int eta,
1910             int adaptive, double subsample) {
1911             dTHX;
1912             AV* trees;
1913             double* x;
1914             int t, n_trees;
1915              
1916             if (!SvROK(trees_av_sv) || SvTYPE(SvRV(trees_av_sv)) != SVt_PVAV)
1917             croak("online_unlearn_row_xs: trees must be an arrayref");
1918             trees = (AV*)SvRV(trees_av_sv);
1919             n_trees = (int)av_len(trees) + 1;
1920              
1921             x = (double*)malloc(nf * sizeof(double));
1922             _ol_read_row(aTHX_ row_sv, x, nf);
1923              
1924             for (t = 0; t < n_trees; t++) {
1925             HV* tree;
1926             SV **csv, **dsv, **rsv;
1927             IV count;
1928              
1929             if (subsample < 1.0 && Drand01() >= subsample) continue;
1930             tree = _ol_tree_hv(aTHX_ trees, t);
1931              
1932             csv = hv_fetch(tree, "count", 5, 1);
1933             count = (SvOK(*csv) ? SvIV(*csv) : 0) - 1;
1934             sv_setiv(*csv, count);
1935             dsv = hv_fetch(tree, "depth_limit", 11, 1);
1936             sv_setnv(*dsv, _ol_rpl((double)count, eta));
1937              
1938             rsv = hv_fetch(tree, "root", 4, 0);
1939             if (rsv && *rsv && SvOK(*rsv)) {
1940             SV* root = *rsv;
1941             SV* nr = _ol_node_unlearn(aTHX_ root, x, nf, 0, eta, adaptive);
1942             if (nr != root) (void)hv_store(tree, "root", 4, nr, 0);
1943             }
1944             }
1945             free(x);
1946             }
1947              
1948             /* online_score_row_xs(trees_av, row_av, nf, eta)
1949             *
1950             * Depth sum of one row across the live trees (walk + per-leaf _rpl
1951             * adjustment) -- the C image of _score_row's loop, used by the
1952             * prequential score_learn path where trees mutate between rows and the
1953             * packed-snapshot scorer can never amortise. Draws nothing. */
1954             double online_score_row_xs(SV* trees_av_sv, SV* row_sv, int nf, int eta) {
1955             dTHX;
1956             AV* trees;
1957             double* x;
1958             double sum = 0.0;
1959             int t, n_trees;
1960              
1961             if (!SvROK(trees_av_sv) || SvTYPE(SvRV(trees_av_sv)) != SVt_PVAV)
1962             croak("online_score_row_xs: trees must be an arrayref");
1963             trees = (AV*)SvRV(trees_av_sv);
1964             n_trees = (int)av_len(trees) + 1;
1965              
1966             x = (double*)malloc(nf * sizeof(double));
1967             _ol_read_row(aTHX_ row_sv, x, nf);
1968              
1969             for (t = 0; t < n_trees; t++) {
1970             HV* tree = _ol_tree_hv(aTHX_ trees, t);
1971             SV** rsv = hv_fetch(tree, "root", 4, 0);
1972             AV* node;
1973             SV** slots;
1974             int depth = 0;
1975              
1976             if (!rsv || !*rsv || !SvOK(*rsv)) continue;
1977             node = (AV*)SvRV(*rsv);
1978             slots = AvARRAY(node);
1979             while (SvIV(slots[OL_TYPE]) != 0) {
1980             int attr = (int)SvIV(slots[OL_ATTR]);
1981             double split = SvNV(slots[OL_SPLIT]);
1982             node = (AV*)SvRV(slots[(x[attr] < split) ? OL_LEFT : OL_RIGHT]);
1983             slots = AvARRAY(node);
1984             depth++;
1985             }
1986             sum += (double)depth + _ol_rpl((double)SvIV(slots[OL_COUNT]), eta);
1987             }
1988             free(x);
1989             return sum;
1990             }
1991             __INLINE_C__
1992              
1993             # IF_NO_C=1 skips even attempting to set up the C backend -- useful for
1994             # forcing the pure-Perl path without touching every constructor call
1995             # (use_c => 0), e.g. to get a clean timing baseline or to avoid the
1996             # compile attempt's overhead/noise in a container known to lack a
1997             # compiler. Everything below is skipped and $HAS_C stays 0.
1998             unless ( $ENV{IF_NO_C} ) {
1999              
2000             # Defaults recorded when `perl Makefile.PL` ran. Makefile.PL generates
2001             # Algorithm::Classifier::IsolationForest::BuildFlags, capturing the
2002             # IF_* values active at configure time plus whether a prebuilt object
2003             # was scheduled for install (see "Compile at install time" in the POD
2004             # below). From a plain source checkout the generated file is absent,
2005             # the hard defaults here apply, and no prebuilt object is looked for.
2006             my ( $def_opt, $def_arch, $def_no_omp, $prebuilt ) = ( '-O3', '', 0, 0 );
2007             {
2008             local $@;
2009             my $rec = eval {
2010             require Algorithm::Classifier::IsolationForest::BuildFlags;
2011             Algorithm::Classifier::IsolationForest::BuildFlags::flags();
2012             };
2013             if ( ref $rec eq 'HASH' ) {
2014             $def_opt = $rec->{opt} if defined $rec->{opt};
2015             $def_arch = $rec->{arch} if defined $rec->{arch};
2016             $def_no_omp = $rec->{no_openmp} ? 1 : 0;
2017             $prebuilt = $rec->{prebuilt} ? 1 : 0;
2018             }
2019             }
2020              
2021             # -O3 is the usual default: it's safe to enable unconditionally and
2022             # matters here -- the extended-mode oblique dot product is wrapped in
2023             # `#pragma omp simd`, but without aggressive optimization the compiler
2024             # may still emit scalar code. Use OPTIMIZE (not CCFLAGS) -- CCFLAGS is
2025             # prepended to the cc line and would be shadowed by Perl's own `-O2 -g`
2026             # that ExtUtils::MakeMaker appends afterward (last `-O` wins in gcc).
2027             # IF_OPT overrides the level itself (e.g. IF_OPT=-O2 to work around a
2028             # miscompile, or to shorten build time while developing); it's
2029             # validated against a fixed set of GCC/Clang -O flags rather than
2030             # interpolated as-is, since this string eventually reaches a shell
2031             # command line via ExtUtils::MakeMaker.
2032             my $opt = $def_opt;
2033             if ( defined $ENV{IF_OPT} ) {
2034             if ( $ENV{IF_OPT} =~ /\A-O[0123sgz]\z/ ) {
2035             $opt = $ENV{IF_OPT};
2036             } else {
2037             warn "Algorithm::Classifier::IsolationForest: ignoring invalid "
2038             . "IF_OPT value '$ENV{IF_OPT}' (expected one of -O0 -O1 -O2 "
2039             . "-O3 -Os -Og -Oz); using $opt\n";
2040             }
2041             }
2042              
2043             # -march= lets the compiler target specific instruction-set
2044             # extensions (AVX2 gather + FMA, etc.) for the oblique dot product
2045             # and the fit-time min/max scan's `#pragma omp simd` loops.
2046             #
2047             # IF_ARCH= sets it explicitly (e.g. "x86-64-v3", "skylake",
2048             # "znver3") -- validated against a conservative identifier charset
2049             # since, like IF_OPT, it flows into a compiler command line.
2050             # IF_NATIVE=1 remains as shorthand for IF_ARCH=native and is used
2051             # when IF_ARCH isn't set. Prefer a specific IF_ARCH value over
2052             # IF_NATIVE on a machine you don't control exclusively: blanket
2053             # -march=native pulls in whatever the build host has, including
2054             # AVX-512 on some Intel CPUs, which is known to trigger clock
2055             # throttling under sustained heavy use and can make throughput
2056             # *worse* than a conservative target like x86-64-v3 (AVX2, no
2057             # AVX-512). Either way, the cached artefact under _Inline/ is then
2058             # pinned to that instruction set, so leave both unset if the
2059             # directory is shared across machines with different CPUs.
2060             my $arch = $def_arch;
2061             if ( defined $ENV{IF_ARCH} ) {
2062             if ( $ENV{IF_ARCH} eq '' or $ENV{IF_ARCH} eq 'none' ) {
2063              
2064             # Explicit opt-out: overrides an arch recorded at configure
2065             # time (there is no other way to request a plain build on
2066             # an install configured with IF_ARCH).
2067             $arch = '';
2068             } elsif ( $ENV{IF_ARCH} =~ /\A[A-Za-z0-9_.+=-]+\z/ ) {
2069             $arch = $ENV{IF_ARCH};
2070             } else {
2071             warn "Algorithm::Classifier::IsolationForest: ignoring invalid " . "IF_ARCH value '$ENV{IF_ARCH}'\n";
2072             }
2073             } elsif ( $ENV{IF_NATIVE} ) {
2074             $arch = 'native';
2075             }
2076             # -ffp-contract=off rides along with any -march: once the target
2077             # has FMA (x86-64-v3, most -march=native hosts), the compiler may
2078             # otherwise contract a*b+c expressions into fused multiply-adds
2079             # whose different rounding breaks the documented guarantee that
2080             # use_c => 1 and use_c => 0 build bit-identical trees (one ulp in a
2081             # split value cascades into a structurally different tree). The
2082             # -march speedup comes from AVX2 vectorization, not contraction,
2083             # so this costs little (verified against the fit-determinism and
2084             # scoring-parity tests).
2085             my $opt_level = $opt;
2086             $opt_level .= " -march=$arch -ffp-contract=off" if length $arch;
2087              
2088             # IF_NO_OPENMP=1 forces the serial C build: the OpenMP compile attempt
2089             # is skipped, so the object has no libgomp linkage and never starts an
2090             # OpenMP runtime in the process. Distinct from OMP_NUM_THREADS=1,
2091             # which runs the parallel code on a single thread but still loads
2092             # libgomp. An explicit IF_NO_OPENMP=0 re-enables OpenMP over a
2093             # no-openmp configure-time default.
2094             my $no_omp
2095             = defined $ENV{IF_NO_OPENMP}
2096             ? ( $ENV{IF_NO_OPENMP} ? 1 : 0 )
2097             : $def_no_omp;
2098              
2099             # The prebuilt object is only trusted when the effective flags match
2100             # what it was compiled with; any difference -- or an explicit
2101             # IF_RUNTIME_BUILD=1 -- falls through to the classic runtime Inline::C
2102             # build below, which honours the requested flags via the MD5-keyed
2103             # _Inline/ cache exactly as before prebuilt support existed.
2104             # IF_INSTALL_BUILD is the `make` rule driving the install-time compile
2105             # (see Makefile.PL); it must never short-circuit into loading an
2106             # older object.
2107             my $use_prebuilt
2108             = $prebuilt
2109             && !$ENV{IF_RUNTIME_BUILD}
2110             && !$ENV{IF_INSTALL_BUILD}
2111             && $opt eq $def_opt
2112             && $arch eq $def_arch
2113             && $no_omp == $def_no_omp;
2114              
2115             # Inline::C hashes the C source to decide whether to rebuild but
2116             # does NOT include CCFLAGS / OPTIMIZE in that hash. Without the
2117             # tag below, toggling IF_NATIVE/IF_ARCH/IF_OPT (or editing the
2118             # optimisation flags here) would silently reuse a cached binary
2119             # built with stale flags. Embedding the active flags as a leading
2120             # comment forces the hash to differ when they change. The OpenMP
2121             # and serial builds get distinct tags so they cache to separate
2122             # artefacts.
2123             my $omp_tag = "/* if_build: openmp $opt_level */\n";
2124             my $serial_tag = "/* if_build: serial $opt_level */\n";
2125              
2126             if ( $ENV{IF_INSTALL_BUILD} ) {
2127              
2128             # `make` is driving: the rule Makefile.PL appended runs this load
2129             # with IF_INSTALL_BUILD=1 and @ARGV = (version, INST_ARCHLIB),
2130             # which is where Inline's install mode reads them from. _INSTALL_
2131             # makes Inline compile the backend and place the shared object
2132             # under blib/arch so `make install` ships it; NAME/VERSION give
2133             # the object a fixed identity XSLoader can find at run time
2134             # (Inline's install mode also requires both and checks VERSION
2135             # against $ARGV[0]). Same OpenMP-then-serial fallback as the
2136             # runtime build below.
2137             my @install = (
2138             NAME => __PACKAGE__,
2139             VERSION => $VERSION,
2140             _INSTALL_ => 1,
2141             );
2142             unless ($no_omp) {
2143             local $@;
2144             eval {
2145             require Inline;
2146             Inline->import(
2147             C => $omp_tag . $C_CODE,
2148             CCFLAGS => '-fopenmp',
2149             OPTIMIZE => $opt_level,
2150             LIBS => '-lm -lgomp',
2151             @install,
2152             );
2153             $HAS_C = 1;
2154             };
2155             } ## end unless ($no_omp)
2156             unless ($HAS_C) {
2157             local $@;
2158             eval {
2159             require Inline;
2160             Inline->import(
2161             C => $serial_tag . $C_CODE,
2162             OPTIMIZE => $opt_level,
2163             LIBS => '-lm',
2164             @install,
2165             );
2166             $HAS_C = 1;
2167             };
2168             } ## end unless ($HAS_C)
2169             $C_SOURCE = 'prebuilt' if $HAS_C;
2170             } else {
2171              
2172             # Fast path: the object compiled at `make` time was installed
2173             # under auto/ like any XS module, so plain XSLoader digs it out of
2174             # @INC with no Inline involvement -- no compiler, no _Inline/
2175             # directory, and a few ms instead of a first-run compile. Any
2176             # failure (object deleted, different perl, version mismatch after
2177             # an upgrade, libgomp since removed) just falls through to the
2178             # runtime build.
2179             if ($use_prebuilt) {
2180             local $@;
2181             eval {
2182             require XSLoader;
2183             XSLoader::load( __PACKAGE__, $VERSION );
2184             $HAS_C = 1;
2185             $C_SOURCE = 'prebuilt';
2186             };
2187             }
2188              
2189             # Classic runtime Inline::C build, MD5-cached under _Inline/.
2190             # Reached when there is no matching prebuilt object: a source
2191             # checkout, IF_RUNTIME_BUILD=1, or IF_* values differing from the
2192             # ones recorded at configure time. Try compiling with OpenMP
2193             # first; on any failure (compiler doesn't accept -fopenmp, libgomp
2194             # missing, etc.) fall back to a serial build.
2195             unless ( $HAS_C or $no_omp ) {
2196             local $@;
2197             eval {
2198             require Inline;
2199             Inline->import(
2200             C => $omp_tag . $C_CODE,
2201             CCFLAGS => '-fopenmp',
2202             OPTIMIZE => $opt_level,
2203             LIBS => '-lm -lgomp',
2204             );
2205             $HAS_C = 1;
2206             $C_SOURCE = 'runtime';
2207             };
2208             } ## end unless ( $HAS_C or $no_omp )
2209             unless ($HAS_C) {
2210             local $@;
2211             eval {
2212             require Inline;
2213             Inline->import(
2214             C => $serial_tag . $C_CODE,
2215             OPTIMIZE => $opt_level,
2216             LIBS => '-lm',
2217             );
2218             $HAS_C = 1;
2219             $C_SOURCE = 'runtime';
2220             };
2221             } ## end unless ($HAS_C)
2222             } ## end else [ if ( $ENV{IF_INSTALL_BUILD} ) ]
2223             $OPT_LEVEL = $opt_level if $HAS_C;
2224              
2225             } ## end unless ( $ENV{IF_NO_C} )
2226             $HAS_OPENMP = ( $HAS_C && defined &has_openmp_xs && has_openmp_xs() ) ? 1 : 0;
2227             $HAS_SIMD = ( $HAS_C && defined &has_simd_xs && has_simd_xs() ) ? 1 : 0;
2228             }
2229              
2230             =encoding UTF-8
2231              
2232             =head1 NAME
2233              
2234             Algorithm::Classifier::IsolationForest - unsupervised anomaly detection via Isolation Forest or Extended Isolation Forest
2235              
2236             =head1 SYNOPSIS
2237              
2238             use Algorithm::Classifier::IsolationForest;
2239              
2240             my @data = ([0.1, -0.2], [0.0, 0.1], [5.0, 6.0], ...);
2241              
2242             # Classic, axis-parallel Isolation Forest
2243             my $iforest = Algorithm::Classifier::IsolationForest->new(
2244             n_trees => 100,
2245             sample_size => 256,
2246             seed => 42,
2247             );
2248             $iforest->fit(\@data);
2249              
2250             my $scores = $iforest->score_samples(\@data); # arrayref, each in (0,1]
2251             my $flags = $iforest->predict(\@data, 0.6); # arrayref of 0/1
2252              
2253             # Save and reload
2254             $iforest->save('model.json');
2255             my $reloaded = Algorithm::Classifier::IsolationForest->load('model.json');
2256              
2257             # Extended Isolation Forest (oblique hyperplane splits)
2258             my $eif = Algorithm::Classifier::IsolationForest->new(
2259             mode => 'extended',
2260             seed => 42,
2261             );
2262             $eif->fit(\@data);
2263              
2264             # Parallel training (fork-based, Unix-like platforms): build the
2265             # n_trees across several worker processes.
2266             my $iforest = Algorithm::Classifier::IsolationForest->new(
2267             n_trees => 200,
2268             sample_size => 256,
2269             seed => 42,
2270             parallel_fit => 4, # 4 forked workers
2271             );
2272             $iforest->fit(\@data);
2273              
2274             # Pre-pack a dataset to skip the per-call input-walk cost when the
2275             # same data gets scored many times (interactive tuning, dashboards).
2276             my $packed = $iforest->pack_data(\@data);
2277             my $scores = $iforest->score_samples($packed);
2278             my $flags = $iforest->predict($packed, 0.6);
2279              
2280             # Get scores and labels as two flat arrayrefs in one call -- cheaper
2281             # than score_predict_samples when you don't need the paired shape.
2282             my ($s, $l) = $iforest->score_predict_split(\@data, 0.6);
2283              
2284             =head1 DESCRIPTION
2285              
2286             Isolation Forest (Liu, Fei Tony & Ting, Kai & Zhou, Zhi-Hua, 2008) detects anomalies by random
2287             partitioning rather than by modelling normal points. Each tree repeatedly
2288             splits the data. Points that get isolated after only a few splits are likely
2289             anomalies. The score is the average isolation depth across many trees,
2290             normalised so values approach 1 for anomalies and stay below 0.5 for normal
2291             points.
2292              
2293             In extended mode the module implements the Extended Isolation Forest
2294             variant. Each split is a random hyperplane instead of an axis-aligned cut,
2295             which removes the rectangular, axis-aligned bias in the score field and
2296             tends to help on elongated or multi-modal data.
2297              
2298             With C<< voting => 'majority' >> the module implements the Majority Voting
2299             Isolation Forest (MVIForest) aggregation: each tree votes a sample
2300             anomalous or normal against the decision threshold and the label is the
2301             majority of the votes, with prediction stopping early once the majority is
2302             reached. Trees are built identically either way, so this composes with
2303             both axis and extended mode, and an existing model can be flipped between
2304             the two modes with L without refitting; see C under
2305             L.
2306              
2307             For data that arrives as a stream and may drift over time, the companion
2308             class L implements Online
2309             Isolation Forest (Leveni et al. 2024): no C, instead points are
2310             learned as they arrive and forgotten once they age out of a sliding
2311             window. Models saved by either class can be loaded through L,
2312             which dispatches on the stored format tag.
2313              
2314             psi referenced below is ψ or the pitchfork math symbol referenced in the paper,
2315             Liu, Fei Tony & Ting, Kai & Zhou, Zhi-Hua. (2008). Isolation Forest. 413 - 422. 10.1109/ICDM.2008.17.
2316              
2317             ... or max samples.
2318              
2319             L
2320              
2321             =head1 NATIVE ACCELERATION (Inline::C and OpenMP)
2322              
2323             Both the scoring hot path (C, C, C,
2324             C, and C) and the C
2325             tree builder are automatically accelerated through
2326             L when it is installed and a working C compiler is reachable.
2327             If the toolchain also accepts C<-fopenmp> and can link against
2328             C, the per-point tree walk runs in parallel across all
2329             available CPU cores using OpenMP, and the extended-mode oblique dot
2330             product is vectorised via C<#pragma omp simd> -- which on modern x86
2331             compilers translates to an unrolled FMA / AVX gather chain that's
2332             substantially faster for high-feature-count extended models.
2333              
2334             C's tree builder (subsampling plus the recursive axis/oblique
2335             split search) runs in C the same way when C is on, replacing the
2336             per-node Perl arrayref copying with plain int-array partitioning --
2337             typically an order of magnitude faster, and dramatically more so at
2338             higher feature counts where the pure-Perl per-cell loop dominates. Its
2339             random draws go through the same generator C/C use
2340             internally, in the same call order the pure-Perl builder uses, so a
2341             given C produces bit-identical trees whether C is on or
2342             off -- switching backends changes only how fast the model is built, not
2343             the model itself. On perls whose NV is wider than a C double
2344             (C<-Duselongdouble> / C<-Dusequadmath>) the pure-Perl builder rounds
2345             each stored value to double precision to preserve this parity; axis
2346             mode matches exactly, while extended mode can still differ on rare
2347             libm rounding ties (double vs long-double transcendentals).
2348              
2349             By default this C builder is single-threaded per call, because Perl's
2350             RNG state isn't safe to share across OpenMP threads. Two ways to scale
2351             fit() across cores are available (see below for why they don't compose):
2352              
2353             =over 4
2354              
2355             =item * C forks N worker processes, each building its
2356             share of the trees with the (still single-threaded) C builder. Fixed
2357             IPC/serialisation overhead per worker means this can cost more than it
2358             saves once a fit already completes in milliseconds; it's most useful
2359             once a single-process fit is large enough that the fork/Storable
2360             overhead is small relative to the work being split.
2361              
2362             =item * C builds trees across OpenMP threads within a
2363             single process (one tree per thread), using a separate, thread-safe
2364             PRNG seeded per tree index instead of Perl's C. This means
2365             trees built with C are I bit-identical to the
2366             default C path for the same seed -- but a fixed seed and
2367             C still reproduce the same trees regardless of
2368             C or how OpenMP schedules the work. It's off by
2369             default (unlike C/C, which only ever change speed,
2370             this changes which trees get built) and only takes effect when C
2371             is also on and OpenMP is linked in.
2372              
2373             =back
2374              
2375             These two do NOT compose, despite both existing to parallelise fit().
2376             A process that has run any OpenMP region -- including plain
2377             C/C with the default C -- and
2378             then Cs (as C does) hands each child a copy of
2379             libgomp's thread pool whose worker threads did not survive the fork. A
2380             child that then starts its own C<#pragma omp parallel> region (as
2381             C would) tries to reuse that now-invalid pool and
2382             hangs. This is a general limitation of combining C with OpenMP,
2383             not something fixable from Perl, so C's forked workers
2384             always use the single-threaded C builder regardless of
2385             C -- setting both just means C wins and
2386             C has no effect for that call.
2387              
2388             Detection happens once when the module is loaded. When the
2389             distribution was installed with C available, the C backend
2390             was already compiled during C and the installed object is loaded
2391             directly (see L below);
2392             otherwise the backend is compiled on first load and the artefact is
2393             cached under C<_Inline/> and reused on subsequent runs. Five package
2394             variables report what the load picked up:
2395              
2396             $Algorithm::Classifier::IsolationForest::HAS_C # 0/1
2397             $Algorithm::Classifier::IsolationForest::HAS_OPENMP # 0/1
2398             $Algorithm::Classifier::IsolationForest::HAS_SIMD # 0/1 (OpenMP 4.0+)
2399             $Algorithm::Classifier::IsolationForest::OPT_LEVEL # e.g. "-O3 -march=native", '' if HAS_C is 0
2400             $Algorithm::Classifier::IsolationForest::C_SOURCE # 'prebuilt' / 'runtime', '' if HAS_C is 0
2401              
2402             Neither dependency is required. Without C the module falls
2403             back to a pure-Perl implementation that produces identical results, just
2404             slower; without OpenMP the C backend runs single-threaded.
2405              
2406             The bundled C subcommand performs a tiny fit + score and
2407             prints which backend is active (including the build flags below), which
2408             is the recommended way to verify the build picked up the optional
2409             dependencies on a given machine.
2410              
2411             =head2 Compile at install time (the prebuilt object)
2412              
2413             When C is usable while the distribution itself is being
2414             built, C arranges for the C backend to be compiled
2415             once during C and installed alongside the module like any XS
2416             object. At run time that object is loaded directly through
2417             L: no C compiler, no C modules, and no C<_Inline/>
2418             cache directory are needed on the machine the module ends up running
2419             on, and the first-load compile pause disappears entirely.
2420              
2421             On x86-64 hardware from roughly the last decade,
2422             C is a reasonable configure line:
2423             it bakes AVX2 + FMA (without AVX-512) into the prebuilt object, which
2424             can speed up extended-mode scoring (how much is hardware-dependent --
2425             benchmark with C before assuming) while avoiding the
2426             C<-march=native> caveats described under L.
2427             Bit-for-bit result parity with the pure-Perl backend is preserved
2428             either way (see C below).
2429              
2430             The C build flags described below are captured when
2431             C runs -- set them in the environment of I
2432             command, not of C -- and recorded in the generated
2433             C module, which
2434             thereby also fixes what the prebuilt object was compiled with. At run
2435             time the recorded values serve as the defaults, so a process started
2436             with no C variables set uses the prebuilt object as-is.
2437              
2438             Setting C variables at run time keeps working exactly as in
2439             releases without prebuilt support: if the requested flags differ from
2440             the recorded ones, the prebuilt object (compiled with the wrong flags
2441             for the request) is skipped and the module compiles at first load into
2442             C<_Inline/> -- which does need C and a compiler on that
2443             machine. Two related knobs exist:
2444              
2445             =over 4
2446              
2447             =item * C -- ignore the prebuilt object
2448             unconditionally and compile at first load even though the requested
2449             flags match the recorded ones. Useful when the installed object is
2450             suspect (built on a different CPU than it now runs on, linked against a
2451             libgomp that has since changed) or to A/B a fresh local build against
2452             the shipped one.
2453              
2454             =item * C -- internal; set by the generated
2455             Makefile rule that performs the install-time compile. Not meant for
2456             manual use.
2457              
2458             =back
2459              
2460             If the prebuilt object cannot be loaded for any reason (deleted, built
2461             against a different perl, version mismatch after an upgrade), the
2462             module quietly falls through the same chain as always: runtime
2463             Inline::C build first, pure Perl last.
2464              
2465             =head2 Tuning the C build
2466              
2467             These environment variables are read once, the first time the module is
2468             loaded, so they must be set before that -- e.g. in the shell before
2469             running a script, not via C<%ENV> inside the script itself. They are
2470             also read by C to pick the flags baked into the
2471             prebuilt object (see above); at run time they override the recorded
2472             configure-time values, at the price of a runtime compile.
2473              
2474             =over 4
2475              
2476             =item * C -- skip attempting to build the C backend entirely.
2477             Equivalent to constructing every instance with C 0>, but
2478             without needing to touch every call site; useful for a clean pure-Perl
2479             timing baseline, or to avoid the compile attempt's overhead/noise on a
2480             host known to lack a C compiler (the attempt already fails gracefully
2481             without this, so it's a convenience, not a correctness fix).
2482              
2483             =item * C (or C<-O0>/C<-O1>/C<-Os>/C<-Og>/C<-Oz>) -- override
2484             the default C<-O3>, e.g. to shorten build time while iterating, or work
2485             around a miscompile on an unusual toolchain. Invalid values are ignored
2486             with a warning rather than passed through, since this string reaches a
2487             compiler command line.
2488              
2489             =item * CvalueE> -- adds C<-march=EvalueE> so the
2490             compiler can target specific instruction-set extensions (AVX2 gather +
2491             FMA, etc.) for the extended-mode oblique dot product and the fit-time
2492             min/max scan's C<#pragma omp simd> loops. Accepts values like
2493             C, C, or C -- whatever your compiler's
2494             C<-march=> accepts. Also validated (a restricted character set, not
2495             passed through as-is) for the same reason as C. The special
2496             value C (or an empty string) opts out of any arch recorded at
2497             configure time, yielding a plain build. Whenever a C<-march> is in
2498             effect the build also adds C<-ffp-contract=off>: with FMA available
2499             the compiler would otherwise contract C into fused
2500             multiply-adds whose different rounding breaks the guarantee that
2501             C 1> and C 0> build bit-identical trees (the
2502             C<-march> speedup comes from vectorization, not contraction, so this
2503             costs essentially nothing).
2504              
2505             =item * C -- shorthand for C; ignored if
2506             C is also set. Prefer a specific C value over this on
2507             a machine you don't control exclusively (a shared build host, a
2508             container base image): blanket C<-march=native> pulls in whatever
2509             instruction sets the build host happens to have, including AVX-512 on
2510             some Intel CPUs -- which is known to trigger clock throttling under
2511             sustained heavy use and can make throughput I than a
2512             conservative target like C (AVX2, no AVX-512). If in doubt,
2513             benchmark both before committing to one.
2514              
2515             =item * C -- build (or select) the serial C backend: the
2516             OpenMP compile attempt is skipped entirely, so the resulting object has
2517             no libgomp linkage and never starts an OpenMP runtime inside the
2518             process. This differs from C, which merely runs the
2519             parallel code on one thread but still loads libgomp. Set at
2520             C time it yields a serial prebuilt object; set at run
2521             time against an OpenMP prebuilt install it triggers a runtime serial
2522             build (needing a compiler). An explicit C re-enables
2523             OpenMP over a serial configure-time default.
2524              
2525             =back
2526              
2527             Whichever of these are used, the cached artefact under C<_Inline/> is
2528             pinned to that build's instruction set -- delete C<_Inline/> (or use a
2529             separate one per host) if the directory is shared across machines with
2530             different CPUs, or a stale binary built for a narrower instruction set
2531             than the current host will simply keep being reused.
2532              
2533             =head2 Tuning the OpenMP runtime
2534              
2535             These are standard OpenMP environment variables libgomp already reads
2536             at run time (set before running your script, no module-specific
2537             handling needed) -- listed here because they matter most for exactly
2538             the workloads this module has: C's per-point parallel
2539             loop and C's per-tree parallel loop.
2540              
2541             =over 4
2542              
2543             =item * C -- caps how many threads a parallel region
2544             uses. Useful to leave headroom for other work sharing the machine, or
2545             to pin down C reproducibility checks (see its docs
2546             above: results don't depend on this, but it's a natural thing to vary
2547             when confirming that).
2548              
2549             =item * C / C -- on multi-socket
2550             or otherwise NUMA machines, pins each thread to a core near where its
2551             data already lives instead of letting the OS scheduler migrate threads
2552             across sockets mid-run. Both C (each thread scans its own
2553             slice of the packed query buffer) and C (each thread
2554             builds one tree from packed training data) benefit from this when the
2555             input is large enough to not fit comfortably in one socket's cache.
2556              
2557             =back
2558              
2559             These cost nothing to try -- unlike C/C, they're
2560             read fresh every run, not baked into a cached binary, so there's no
2561             downside to experimenting per invocation.
2562              
2563             =head1 GENERAL METHODS
2564              
2565             =head2 new(%args)
2566              
2567             Inits the object.
2568              
2569             - n_trees :: number of isolation trees in the ensemble
2570             default :: 100
2571              
2572             - sample_size :: sub-sample size used to build each tree... max samples
2573             default :: 256
2574              
2575             - max_depth :: per-tree height limit... if not defined is set to ceil(log2(psi))
2576             default :: undef
2577              
2578             - seed :: optional integer to seed srand with for reproducible trees...
2579             see perldoc -f srand for more info. This number is processed via abs(int()).
2580             default :: undef
2581              
2582             - mode :: if it should be IF or EIF
2583             axis :: classic axis-parallel splits (IF)
2584             extended :: oblique hyperplane splits (EIF)
2585             default :: axis
2586              
2587             - extension_level :: extended mode only... how many features take partin each
2588             split. 0 behaves like a single-feature (axis) cut; the
2589             maximum (n_features - 1) uses every varying feature. undef
2590             => maximum. Clamped to [0, n_features - 1] at fit time.
2591              
2592             - contamination :: expected fraction of anomalies, in (0, 0.5]. When given,
2593             fit() learns a score threshold that flags this fraction of
2594             the training set, and predict() uses it by default. undef
2595             => no learned threshold (predict() falls back to 0.5).
2596             default :: undef
2597              
2598             - missing :: how fit() treats undef (missing) feature cells. Scoring always
2599             tolerates undef regardless of this setting; it governs fit().
2600             die :: croak from fit() if the training data contains any
2601             undef cell. Scoring still maps undef to 0 (the
2602             long-standing behaviour), so a model fitted on clean
2603             data can still score rows with missing features.
2604             zero :: treat a missing cell as the value 0, at fit and score.
2605             impute :: replace a missing cell with the per-feature mean (or
2606             median, see impute_with) learned from the present
2607             values at fit time. The fill vector is stored on the
2608             model and reused for scoring and persistence.
2609             nan :: build feature ranges from present values only and route
2610             a point missing the split feature to the right child,
2611             consistently at fit and score time. Missingness is
2612             preserved as signal rather than filled.
2613             default :: die
2614              
2615             - impute_with :: 'mean' or 'median'; the statistic used to compute the
2616             per-feature fill under missing => 'impute'. Ignored otherwise.
2617             default :: mean
2618              
2619             - voting :: how the per-tree results are aggregated at scoring time.
2620             Trees are built identically in both settings -- only aggregation
2621             changes -- so the knob composes with either mode (axis or
2622             extended) and an existing model may switch it after the fact with
2623             set_voting() (which relearns a contamination threshold for the
2624             new mode).
2625             mean :: classic Isolation Forest: a sample's path lengths
2626             across all trees are averaged and normalised into
2627             one anomaly score; predict() thresholds that score.
2628             majority :: Majority Voting Isolation Forest (MVIForest;
2629             Chabchoub, Togbe, Boly & Chiky 2022 -- see
2630             REFERENCES). Each tree scores the sample on its own
2631             (s_i = 2**(-h_i / c(psi))) and votes it anomalous
2632             when s_i >= the decision threshold; predict() flags
2633             the sample when more than half of the trees
2634             (int(n_trees/2) + 1) vote anomalous, and stops
2635             walking trees per sample as soon as the outcome is
2636             decided. The threshold argument/default of the
2637             predict methods is therefore the PER-TREE cutoff
2638             here, not a forest-level score cutoff.
2639             score_samples() returns the fraction of trees
2640             voting anomalous -- still in [0, 1], but discrete
2641             in steps of 1/n_trees. contamination composes: fit()
2642             learns the per-tree cutoff that flags the requested
2643             fraction of the training set.
2644             default :: mean
2645              
2646             - parallel_fit :: positive integer N => build the trees across N forked
2647             worker processes during fit(). Each worker gets a derived seed
2648             (parent seed + worker_id * 1009) so the parallel fit is
2649             reproducible across runs at fixed worker count -- but the trees
2650             produced are NOT bit-identical to a serial fit with the same
2651             seed, because the RNG draws happen in a different order.
2652             Inference is unaffected. Falls back silently to serial on
2653             platforms without a real fork() (e.g. Windows without Cygwin).
2654             default :: undef (serial)
2655              
2656             - use_c :: boolean, override whether the Inline::C backend is used for
2657             both scoring and fit()'s tree builder. When false the instance
2658             falls back to pure Perl for both even if the C backend compiled
2659             successfully. When true (or unset) the C backend is used if
2660             available ($HAS_C). fit() with use_c on produces bit-identical
2661             trees to use_c off for the same seed -- only build speed differs.
2662             default :: $HAS_C
2663              
2664             - use_openmp :: boolean, override whether OpenMP parallel scoring is
2665             used inside score_all_xs(). When false the C tree walk runs
2666             single-threaded even if OpenMP was linked in. Ignored when
2667             use_c is false (pure Perl has no OpenMP path).
2668             default :: $HAS_OPENMP
2669              
2670             - use_openmp_fit :: boolean, build fit()'s trees across OpenMP threads
2671             (one tree per thread) instead of the single-threaded C builder.
2672             Opt-in and off by default: unlike use_c/use_openmp, this changes
2673             which trees get built. Perl's RNG isn't safe to call from
2674             multiple OS threads sharing one interpreter, so this path seeds
2675             an independent PRNG per tree from the tree index rather than
2676             Drand01() -- trees differ from the use_c (single-threaded)
2677             and pure-Perl paths even with the same seed, though a fixed
2678             seed and n_trees still reproduce the same trees regardless of
2679             OMP_NUM_THREADS or scheduling. Does NOT compose with
2680             parallel_fit: a forked child starting its own OpenMP region
2681             after the parent process has used OpenMP for anything can
2682             hang (a general fork()+libgomp limitation), so parallel_fit's
2683             workers always use the single-threaded C builder regardless
2684             of this setting -- setting both just means parallel_fit wins.
2685             Ignored (clamped to 0) when use_c is false or OpenMP isn't
2686             linked in.
2687             default :: 0
2688              
2689             - feature_names :: optional arrayref of per-feature labels enabling the
2690             *_tagged methods (and required by mungers below).
2691             default :: undef
2692              
2693             - mungers :: optional hashref of declarative L
2694             specs, keyed as that module's compile() expects (scalar mungers by
2695             their output tag, expanding mungers by any label with an 'into'
2696             list, combining mungers by their output tag with a 'from' list).
2697             When set, every tagged row -- the *_tagged methods, fit_tagged,
2698             and tagged_row_to_array -- is munged from raw values (strings,
2699             timestamps, status codes, ...) into numbers through the compiled
2700             plan, and munge_rows() applies the scalar mungers to positional
2701             rows. Requires feature_names; the plan compiles against them, so
2702             any spec error croaks here in new(). Algorithm::ToNumberMunger is
2703             an optional dependency, required only when a spec is given (or a
2704             loaded model carrying one is used with tagged data). The spec is
2705             saved with the model, so a loaded model munges scoring input
2706             exactly as it did training input. See L for details
2707             and caveats.
2708             default :: undef
2709              
2710             - schema_version :: optional opaque string identifying the revision of
2711             the variable schema this model was built against. Never parsed
2712             or compared numerically; saved with the model and shown by
2713             `iforest info`. Usually set from a prototype (see
2714             L) rather than passed directly.
2715             default :: undef
2716              
2717             - schema_description :: optional opaque free-text description of what
2718             the variable schema is. Same handling as schema_version.
2719             default :: undef
2720              
2721             - feature_descriptions :: optional hashref of 'feature name => free
2722             text' describing individual features. Requires feature_names;
2723             every key must name an entry there (a description for a feature
2724             that does not exist croaks -- it is either a typo or a stale
2725             leftover from a schema change). Partial coverage is fine.
2726             Saved with the model and shown beside each tag by
2727             `iforest info`.
2728             default :: undef
2729              
2730             Note: log2 under Perl is as below...
2731              
2732             log($psi) / log(2)
2733              
2734             =cut
2735              
2736             sub new {
2737 213     213 1 30269976 my ( $class, %args ) = @_;
2738              
2739 213   100     1348 my $mode = $args{mode} // 'axis';
2740 213 100 100     1174 croak "mode must be 'axis' or 'extended'"
2741             unless $mode eq 'axis' || $mode eq 'extended';
2742              
2743             # How fit() treats undef (missing) feature cells. Scoring always
2744             # tolerates undef regardless of this setting -- it governs fit only.
2745             # die :: croak if the training data contains any undef cell (default)
2746             # zero :: treat a missing cell as the value 0
2747             # impute :: replace a missing cell with the per-feature mean/median
2748             # learned from the present values at fit time
2749             # nan :: build ranges over present values only and route a point
2750             # missing the split feature consistently to one branch, at
2751             # both fit and score time
2752 212   100     1001 my $missing = $args{missing} // 'die';
2753 212 100       1756 croak "missing must be one of: die, zero, impute, nan"
2754             unless $missing =~ /\A(?:die|zero|impute|nan)\z/;
2755              
2756 211   100     803 my $impute_with = $args{impute_with} // 'mean';
2757 211 100       1139 croak "impute_with must be 'mean' or 'median'"
2758             unless $impute_with =~ /\A(?:mean|median)\z/;
2759              
2760             # How per-tree results are aggregated at scoring time. Trees are
2761             # built identically either way -- this knob never touches fit()'s
2762             # forest, only how score/predict combine the per-tree path lengths.
2763             # mean :: classic IForest: average path length across trees,
2764             # normalised into one score (the default)
2765             # majority :: MVIForest (Chabchoub et al. 2022): each tree votes
2766             # anomalous/normal against the decision threshold and
2767             # the label is the majority of the tree votes
2768 210   100     778 my $voting = $args{voting} // 'mean';
2769 210 100       1163 croak "voting must be 'mean' or 'majority'"
2770             unless $voting =~ /\A(?:mean|majority)\z/;
2771              
2772 209 100       561 if ( defined( $args{seed} ) ) {
2773 166         509 $args{seed} = abs( int( $args{seed} ) );
2774             }
2775              
2776             # Clamp the accel knobs against what the build actually has. Passing
2777             # use_c => 1 on a machine where Inline::C never compiled would otherwise
2778             # leave score_samples() calling an undefined XS sub at first use.
2779             # OpenMP is meaningless without the C tree walk, so force it off
2780             # whenever the C backend is off -- matches the documented
2781             # "Ignored when use_c is false" semantics.
2782             my $use_c
2783             = defined $args{use_c}
2784 209 100 100     978 ? ( $args{use_c} && $HAS_C ? 1 : 0 )
    100          
2785             : $HAS_C;
2786             my $use_openmp
2787             = defined $args{use_openmp}
2788 209 100 100     634 ? ( $args{use_openmp} && $HAS_OPENMP ? 1 : 0 )
    100          
2789             : $HAS_OPENMP;
2790 209 100       530 $use_openmp = 0 unless $use_c;
2791              
2792             # Opt-in only (default 0, not $HAS_OPENMP): this path changes which
2793             # trees fit() builds (see docs above), unlike use_c/use_openmp which
2794             # only change speed. Clamped the same way use_openmp is.
2795 209 100 33     752 my $use_openmp_fit = ( $args{use_openmp_fit} && $HAS_OPENMP && $use_c ) ? 1 : 0;
2796              
2797             my $self = {
2798             n_trees => $args{n_trees} // 100,
2799             sample_size => $args{sample_size} // 256,
2800             max_depth => $args{max_depth}, # undef => auto
2801             seed => $args{seed}, # undef => non-deterministic
2802             mode => $mode,
2803             extension_level => $args{extension_level}, # undef => max, resolved in fit()
2804             contamination => $args{contamination}, # undef => no learned threshold
2805             parallel_fit => $args{parallel_fit}, # undef/0/1 => serial; N>1 => fork
2806             missing => $missing, # die|zero|impute|nan
2807             impute_with => $impute_with, # mean|median (impute mode only)
2808             voting => $voting, # mean|majority (scoring-time aggregation)
2809             missing_fill => undef, # per-feature fill, learned in fit() if impute
2810             _use_c => $use_c,
2811             _use_openmp => $use_openmp,
2812             _use_openmp_fit => $use_openmp_fit,
2813             threshold => undef, # learned in fit() if contamination set
2814             trees => [],
2815             c_psi => undef, # c(psi), set during fit()
2816             n_features => undef,
2817             feature_names => $args{feature_names}, # optional arrayref of per-feature labels
2818             mungers => undef, # optional Algorithm::ToNumberMunger spec hash
2819             # Opaque schema metadata, usually set via new_from_prototype and
2820             # persisted with the model. Never parsed -- documentation that
2821             # travels with the model file.
2822             schema_version => $args{schema_version},
2823             schema_description => $args{schema_description},
2824             feature_descriptions => $args{feature_descriptions},
2825 209   100     3762 };
      100        
2826              
2827 209         562 for my $doc (qw(schema_version schema_description)) {
2828             croak "$doc must be a plain string"
2829 417 100 100     1451 if defined $self->{$doc} && ref $self->{$doc};
2830             }
2831             _validate_feature_descriptions( $self->{feature_names}, $self->{feature_descriptions} )
2832 208 100       543 if defined $self->{feature_descriptions};
2833              
2834             # Optional Algorithm::ToNumberMunger integration: a declarative spec
2835             # hash compiled into a plan that turns raw tagged values into numbers.
2836             # Compiled eagerly so every spec error surfaces here rather than at
2837             # first scoring; the module itself is only required when a spec is
2838             # actually given, keeping it an optional dependency.
2839 205 100       518 if ( defined $args{mungers} ) {
2840             croak "mungers must be a hashref of 'tag => munger spec'"
2841 9 100       172 unless ref $args{mungers} eq 'HASH';
2842             croak "mungers requires feature_names (the munger plan compiles against them)"
2843 8 100 66     239 unless ref $self->{feature_names} eq 'ARRAY' && @{ $self->{feature_names} };
  7         26  
2844 7         15 $self->{mungers} = $args{mungers};
2845 7         31 $self->{_munger_plan} = _compile_mungers( $self->{feature_names}, $self->{mungers} );
2846 5         11468 $self->{munger_module_version} = $Algorithm::ToNumberMunger::VERSION;
2847             }
2848              
2849 201 100       1013 croak "n_trees must be >= 1" unless $self->{n_trees} >= 1;
2850 200 100       624 croak "sample_size must be >= 1" unless $self->{sample_size} >= 1;
2851             croak "extension_level must be >= 0"
2852 199 100 100     701 if defined $self->{extension_level} && $self->{extension_level} < 0;
2853             croak "contamination must be a number in (0, 0.5]"
2854             if defined $self->{contamination}
2855 198 100 100     1039 && !( $self->{contamination} > 0 && $self->{contamination} <= 0.5 );
      100        
2856             croak "parallel_fit must be a positive integer"
2857             if defined $self->{parallel_fit}
2858 195 100 66     1089 && ( $self->{parallel_fit} !~ /^\d+$/ || $self->{parallel_fit} < 1 );
      66        
2859              
2860 193         1051 return bless $self, $class;
2861             } ## end sub new
2862              
2863             =head2 decision_threshold
2864              
2865             The score cutoff C uses by default; undef unless C was
2866             set.
2867              
2868             =cut
2869              
2870 17     17 1 4174 sub decision_threshold { return $_[0]->{threshold} }
2871              
2872             =head2 set_voting
2873              
2874             Switches the scoring-time aggregation between C<'mean'> and C<'majority'> on an
2875             existing model and returns C<$self> (so it chains). The forest itself is
2876             identical in both modes -- only the way per-tree results are combined changes
2877             -- so this never rebuilds a single tree.
2878              
2879             $iforest->set_voting('majority');
2880             $iforest->set_voting('mean', \@training_data);
2881              
2882             The one thing that does not carry over is a C-learned
2883             L. That cutoff is a quantile of whichever per-point
2884             quantity the mode thresholds against -- the averaged anomaly score under
2885             C<'mean'>, the per-tree majority pivot under C<'majority'> -- and those live in
2886             different spaces, so a threshold learned in one mode flags the wrong fraction
2887             in the other. When the model was fitted with C, C
2888             therefore relearns the threshold for the target mode, which requires the
2889             original training data to be passed as the second argument (the model does not
2890             retain it). Switching a model that had no C needs no data:
2891             C falls back to C<0.5>, which is meaningful in both modes.
2892              
2893             Passing the current mode is a no-op (returns immediately, no data needed).
2894             Calling this before L just records the mode for the eventual fit.
2895              
2896             =cut
2897              
2898             sub set_voting {
2899 9     9 1 932 my ( $self, $voting, $data ) = @_;
2900              
2901 9 100 66     299 croak "set_voting: voting must be 'mean' or 'majority'"
2902             unless defined $voting && $voting =~ /\A(?:mean|majority)\z/;
2903              
2904 8 100       41 return $self if $self->{voting} eq $voting;
2905              
2906             # A learned threshold only exists once a contamination-fitted model has
2907             # been fit(); that value is mode-specific and must be relearned against
2908             # the same training set (see _learn_contamination_threshold). Everything
2909             # else -- pre-fit models, and fitted models without contamination -- just
2910             # flips the knob; predict()'s 0.5 fallback is valid in either mode.
2911 7   66     38 my $fitted = ref $self->{trees} eq 'ARRAY' && @{ $self->{trees} };
2912 7   100     31 my $recalibrate = $fitted && defined $self->{contamination};
2913 7 100       21 if ($recalibrate) {
2914 4 100 66     313 croak "set_voting: switching a contamination-fitted model requires "
2915             . "the original training data as the second argument to "
2916             . "recalibrate the decision threshold"
2917             unless ref $data eq 'ARRAY' && @$data;
2918             }
2919              
2920 6         13 $self->{voting} = $voting;
2921 6 100       28 $self->_learn_contamination_threshold($data) if $recalibrate;
2922              
2923 6         35 return $self;
2924             } ## end sub set_voting
2925              
2926             =head2 feature_names
2927              
2928             Returns the arrayref of feature name strings stored with the model, or undef
2929             if none were provided at fit time.
2930              
2931             my $names = $iforest->feature_names;
2932              
2933             =cut
2934              
2935 4     4 1 115 sub feature_names { return $_[0]->{feature_names} }
2936              
2937             =head2 schema_version
2938              
2939             Returns the user-owned schema version string stored with the model
2940             (usually via a prototype -- see L), or undef if none was
2941             recorded.
2942              
2943             my $sv = $iforest->schema_version;
2944              
2945             =cut
2946              
2947 3     3 1 5172 sub schema_version { return $_[0]->{schema_version} }
2948              
2949             =head2 schema_description
2950              
2951             Returns the free-text description of the variable schema stored with the
2952             model, or undef if none was recorded.
2953              
2954             =cut
2955              
2956 3     3 1 24 sub schema_description { return $_[0]->{schema_description} }
2957              
2958             =head2 feature_descriptions
2959              
2960             Returns the hashref of per-feature description strings stored with the
2961             model, or undef if none were recorded. Keys are feature names; coverage
2962             may be partial.
2963              
2964             =cut
2965              
2966 1     1 1 9 sub feature_descriptions { return $_[0]->{feature_descriptions} }
2967              
2968             =head2 fit
2969              
2970             Trains the model on the specified data.
2971              
2972             The data taken is an array of arrays. Each sub-array is one sample and must
2973             contain one or more numeric features. All samples must have the same number
2974             of features. There is no upper limit on dimensionality.
2975              
2976             @training_data = (
2977             [ 3, 5 ],
2978             [ 2.3, 1 ],
2979             [ 5, 9 ],
2980             ...
2981             );
2982              
2983             # Three-feature example
2984             @training_data = (
2985             [ 1.0, 2.0, 3.0 ],
2986             [ 1.1, 1.9, 3.1 ],
2987             ...
2988             );
2989              
2990             Below shows an example of building a gaussian cluster and using that for training.
2991              
2992             # so it is reproducible
2993             srand(7);
2994              
2995             # build a gaussian cluster and add a handful of outliers...
2996              
2997             use constant PI => 3.14159265358979;
2998             sub gaussian {
2999             my ($mu, $sigma) = @_;
3000             my $u1 = rand() || 1e-12;
3001             my $u2 = rand();
3002             my $z = sqrt(-2 * log($u1)) * cos(2 * PI * $u2);
3003             return $mu + $sigma * $z;
3004             }
3005              
3006             # add some normal items
3007             for (1 .. 500) {
3008             push @data, [ gaussian(0, 1), gaussian(0, 1) ];
3009             push @truth, 0;
3010             }
3011             # add some outliers
3012             for (1 .. 20) {
3013             my $angle = rand() * 2 * PI;
3014             my $radius = 5 + rand() * 3; # distance 5..8 from the origin
3015             push @data, [ $radius * cos($angle), $radius * sin($angle) ];
3016             push @truth, 1;
3017             }
3018              
3019             $iforest->fit(\@data);
3020              
3021             =cut
3022              
3023             sub fit {
3024 172     172 1 12446 my ( $self, $data ) = @_;
3025              
3026 172 100 100     1802 croak "fit() expects a non-empty arrayref of samples"
3027             unless ref $data eq 'ARRAY' && @$data;
3028             croak "each sample must be an arrayref of features"
3029 166 100 100     834 unless ref $data->[0] eq 'ARRAY' && @{ $data->[0] };
  164         927  
3030              
3031 162         274 my $n_features = scalar @{ $data->[0] };
  162         388  
3032 162         627 $self->{n_features} = $n_features;
3033              
3034             # Apply the missing-value strategy before any tree is built. Depending
3035             # on the strategy this either croaks (die), returns a dense copy with
3036             # undef cells filled (zero/impute), or passes the data through with
3037             # undef preserved for the split logic to route (nan). Everything below
3038             # trains on $train, never the raw $data.
3039 162         780 my $train = $self->_prepare_fit_data($data);
3040              
3041 156         312 my $n = scalar @$train;
3042              
3043             # The sub-sample cannot be larger than the data set itself.
3044 156         825 my $psi = min( $self->{sample_size}, $n );
3045 156         580 $self->{c_psi} = _c($psi);
3046 156         383 $self->{psi_used} = $psi;
3047              
3048             # Resolve the extension level against the data's dimensionality.
3049 156 100       497 if ( $self->{mode} eq 'extended' ) {
3050 32         71 my $max_ext = $n_features - 1;
3051             my $ext
3052             = defined $self->{extension_level}
3053             ? $self->{extension_level}
3054 32 100       97 : $max_ext;
3055 32 50       91 $ext = 0 if $ext < 0;
3056 32 100       79 $ext = $max_ext if $ext > $max_ext;
3057 32         71 $self->{extension_level_used} = $ext;
3058             } else {
3059 124         354 $self->{extension_level_used} = undef;
3060             }
3061              
3062             # Height limit: the average tree height ceil(log2(psi)). Past this depth the
3063             # remaining points are scored using the c(size) adjustment instead.
3064             my $limit
3065             = defined $self->{max_depth}
3066             ? $self->{max_depth}
3067 156 50       1524 : ceil( log($psi) / log(2) );
3068 156 50       441 $limit = 1 if $limit < 1;
3069 156         353 $self->{max_depth_used} = $limit;
3070              
3071 156 100       635 srand( $self->{seed} ) if defined $self->{seed};
3072              
3073 156         319 my $workers = $self->{parallel_fit};
3074 156 100 100     1211 if ( defined $workers
    100 66        
    100 66        
      66        
3075             && $workers > 1
3076             && $self->{n_trees} > 1
3077             && _fork_supported() )
3078             {
3079 8         44 $self->{trees} = $self->_fit_trees_parallel( $train, $psi, $limit, $workers );
3080             } elsif ( $self->{_use_c} && $self->{_use_openmp_fit} ) {
3081 7         39 $self->{trees} = $self->_build_forest_openmp( $train, $psi, $limit, $self->{n_trees} );
3082             } elsif ( $self->{_use_c} ) {
3083             $self->{trees}
3084 92         510 = $self->_build_forest_c( $train, $psi, $limit, $self->{n_trees} );
3085             } else {
3086 49         90 my @trees;
3087 49         143 for ( 1 .. $self->{n_trees} ) {
3088 2249         6715 my $sample = _subsample( $train, $psi );
3089 2249         6102 push @trees, $self->_build_tree( $sample, 0, $limit );
3090             }
3091 49         224 $self->{trees} = \@trees;
3092             }
3093              
3094             # On a re-fit, packed scoring buffers from the previous fit are still
3095             # sitting on the object; score_samples() below would pick them up and
3096             # learn the contamination threshold against the OLD forest. Drop them
3097             # so the training-set scoring runs pure-Perl against the trees just
3098             # built; _rebuild_c_trees repacks from the new trees at the end.
3099 156         872 delete @$self{qw(_c_nodes _c_coef_idx _c_coef_val)};
3100              
3101             # If a contamination rate was requested, learn the score cutoff that flags
3102             # that fraction of the training set. The threshold lands midway inside a
3103             # real gap between flagged and unflagged training scores (ties at the
3104             # k-boundary shift the cut to the nearest gap -- see
3105             # _threshold_from_ranked), so it sits strictly between attainable values:
3106             # unambiguous and robust to the tiny float rounding introduced by JSON
3107             # serialisation.
3108             #
3109             # Under voting => 'majority' the value predict() thresholds against is
3110             # the PER-TREE score, so the quantity to rank is each training point's
3111             # majority pivot -- the per-tree cutoff at which that point loses its
3112             # majority (see _majority_pivot_scores). A point is flagged iff its
3113             # pivot >= threshold, exactly the relation the mean-mode score has, so
3114             # the midpoint selection below serves both modes unchanged.
3115             $self->_learn_contamination_threshold($train)
3116 156 100       696 if defined $self->{contamination};
3117              
3118 156 100       944 $self->_rebuild_c_trees() if $self->{_use_c};
3119 156         3371 return $self;
3120             } ## end sub fit
3121              
3122             =head2 fit_tagged(\@rows)
3123              
3124             Trains the model on an arrayref of hashrefs of named feature values --
3125             the tagged counterpart of L. Each row goes through
3126             L (and therefore through the munger plan when
3127             C is configured, which is the point: training data and scoring
3128             data are munged by the identical plan), then the positional rows are
3129             handed to C.
3130              
3131             $iforest->fit_tagged([
3132             { cpu => 0.9, mem => 0.4, disk => 0.1 },
3133             { cpu => 0.2, mem => 0.3, disk => 0.2 },
3134             ...
3135             ]);
3136              
3137             Requires stored C. Croaks under the same conditions as
3138             L, naming the offending row by index.
3139              
3140             =cut
3141              
3142             sub fit_tagged {
3143 4     4 1 1521 my ( $self, $data ) = @_;
3144 4 50 33     23 croak "fit_tagged() expects a non-empty arrayref of hashref samples"
3145             unless ref $data eq 'ARRAY' && @$data;
3146 4         5 my @rows;
3147 4         12 for my $i ( 0 .. $#$data ) {
3148 670         1111 push @rows, $self->tagged_row_to_array( $data->[$i], "fit_tagged (row $i)" );
3149             }
3150 4         16 return $self->fit( \@rows );
3151             } ## end sub fit_tagged
3152              
3153             =head2 pack_data(\@data)
3154              
3155             Returns an opaque, blessed wrapper around the input dataset that the
3156             scoring methods can use directly, skipping the per-call work of walking
3157             the arrayref-of-arrayrefs and converting each cell into a double. At
3158             high feature counts this is a meaningful win when the same dataset is
3159             scored repeatedly (e.g. interactive threshold tuning, dashboards,
3160             plotting that updates as parameters change).
3161              
3162             Requires the Inline::C backend; croaks if C is false.
3163              
3164             my $packed = $forest->pack_data(\@data);
3165              
3166             # Now any of these accept either an arrayref or the packed wrapper:
3167             my $scores = $forest->score_samples($packed);
3168             my $flags = $forest->predict($packed, 0.6);
3169             my ($s, $l) = $forest->score_predict_split($packed);
3170              
3171             The wrapper has C and C accessors for introspection.
3172             The feature count is matched against the model on every call; passing a
3173             packed dataset built for a different feature count is a fatal error.
3174              
3175             =cut
3176              
3177             =head2 path_lengths(\@data)
3178              
3179             Returns an arrayref of the mean isolation depth per sample, for inspection.
3180              
3181             my $lengths = $forest->path_lengths(\@data);
3182              
3183             print "x, y, length\n";
3184              
3185             my $int=0;
3186             while (defined($data[$int])) {
3187             print $data[$int][0].', '.$data[$int][1].', '.$lengths->[$int]."\n";
3188              
3189             $int++;
3190             }
3191              
3192             =cut
3193              
3194             sub path_lengths {
3195 112     112 1 13877 my ( $self, $data ) = @_;
3196 112         356 $self->_check_fitted;
3197 110         263 my $trees = $self->{trees};
3198 110         221 my $t = scalar @$trees;
3199              
3200 110 50 66     420 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3201 109         291 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3202 109         257 my $sums_packed = "\0" x ( $n_pts * 8 );
3203             score_all_xs(
3204             $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3205             $x_packed, $sums_packed, $n_pts,
3206             $nf, $t, $self->{_use_openmp}
3207 109         605906 );
3208 109         458 my $result = [];
3209 109         761 finalize_path_lengths_xs( $sums_packed, $n_pts, $t + 0.0, $result );
3210 109         1000 return $result;
3211             } ## end if ( $self->{_use_c} && $self->{_c_nodes} )
3212              
3213 1         6 $data = $self->_prepare_perl_input($data);
3214 1 50       4 my $nan = $self->{missing} eq 'nan' ? 1 : 0;
3215              
3216             # Pure-Perl fallback (tree-outer, sample-inner for cache locality).
3217 1         6 my @sums = (0) x @$data;
3218 1         3 for my $tree (@$trees) {
3219 60         131 for my $i ( 0 .. $#$data ) {
3220 6000         9258 $sums[$i] += _path_length( $data->[$i], $tree, 0, $nan );
3221             }
3222             }
3223 1         8 return [ map { $_ / $t } @sums ];
  100         137  
3224             } ## end sub path_lengths
3225              
3226             =head2 predict(\@data, $threshold)
3227              
3228             Returns an arrayref of 0/1 labels for the specified data.
3229              
3230             If threshold is not specified it uses the contamination-learned cutoff (if
3231             C was called with C), otherwise 0.5.
3232              
3233             Under C<< voting => 'majority' >> the threshold is the per-tree score
3234             cutoff each tree votes against, and a sample is labelled 1 when more than
3235             half of the trees (C) vote it anomalous. Tree walking
3236             stops per sample as soon as the outcome is decided, so this is typically
3237             cheaper than scoring.
3238              
3239             my $results = $forest->predict(\@data, $threshold);
3240              
3241             print "x, y, result\n";
3242              
3243             my $int=0;
3244             while (defined($data[$int])) {
3245             print $data[$int][0].', '.$data[$int][1].', '.$results->[$int]."\n";
3246              
3247             $int++;
3248             }
3249              
3250             =cut
3251              
3252             sub predict {
3253 289     289 1 85254 my ( $self, $data, $threshold ) = @_;
3254             $threshold
3255             = defined $threshold ? $threshold
3256             : defined $self->{threshold} ? $self->{threshold}
3257 289 100       817 : 0.5;
    100          
3258 289         923 $self->_check_fitted;
3259              
3260             # Majority voting: $threshold is the PER-TREE score cutoff and the
3261             # label is the majority of the tree votes (int(t/2) + 1). Both the C
3262             # and the Perl loop stop walking a sample's remaining trees as soon
3263             # as the outcome is decided -- MVIForest's "stop at majority" saving.
3264 287 100       832 if ( $self->{voting} eq 'majority' ) {
3265 18         61 my $trees = $self->{trees};
3266 18         43 my $t = scalar @$trees;
3267 18         93 my $cut = _depth_cut( $threshold, $self->{c_psi} );
3268 18         55 my $maj = _min_votes($t);
3269              
3270 18 50 66     94 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3271 16         60 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3272 16         53 my $labels_packed = "\0" x ( $n_pts * 8 );
3273             vote_all_xs( $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3274 16         58244 $x_packed, $labels_packed, $n_pts, $nf, $t, $cut, $maj, $self->{_use_openmp} );
3275 16         85 my $result = [];
3276 16         124 vote_labels_xs( $labels_packed, $n_pts, $result );
3277 16         107 return $result;
3278             }
3279              
3280 2         11 my $rows = $self->_prepare_perl_input($data);
3281 2 50       9 my $nan = $self->{missing} eq 'nan' ? 1 : 0;
3282 2         4 my @labels;
3283 2         5 for my $x (@$rows) {
3284 126         136 my $votes = 0;
3285 126         141 my $label = 0;
3286 126         187 for my $ti ( 0 .. $t - 1 ) {
3287 3397 100       4309 if ( _path_length( $x, $trees->[$ti], 0, $nan ) <= $cut ) {
3288 1003         1083 $votes++;
3289 1003 100       1331 if ( $votes >= $maj ) { $label = 1; last }
  9         13  
  9         12  
3290             }
3291 3388 100       5096 last if $votes + ( $t - 1 - $ti ) < $maj;
3292             }
3293 126         234 push @labels, $label;
3294             } ## end for my $x (@$rows)
3295 2         14 return \@labels;
3296             } ## end if ( $self->{voting} eq 'majority' )
3297              
3298             # Fast path: threshold the raw path-length sums directly, skipping the
3299             # per-point exp() and the intermediate scores arrayref.
3300             # Derivation: score = exp(-sum * log(2) / (c*t))
3301             # so score >= T iff sum <= -log(T) * c * t / log(2)
3302             # Only valid for a normal threshold in (0, 1) and a positive c.
3303 269 100 66     2032 if ( $self->{_use_c}
      33        
      66        
      100        
3304             && $self->{_c_nodes}
3305             && $self->{c_psi} > 0
3306             && $threshold > 0
3307             && $threshold < 1 )
3308             {
3309 252         437 my $trees = $self->{trees};
3310 252         411 my $t = scalar @$trees;
3311 252         414 my $c = $self->{c_psi};
3312 252         635 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3313 252         587 my $sums_packed = "\0" x ( $n_pts * 8 );
3314             score_all_xs(
3315             $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3316             $x_packed, $sums_packed, $n_pts,
3317             $nf, $t, $self->{_use_openmp}
3318 252         1304165 );
3319 252         3978 my $sum_threshold = -log($threshold) * $c * $t / log(2);
3320 252         546 my $result = [];
3321 252         1375 predict_sums_xs( $sums_packed, $n_pts, $sum_threshold, $result );
3322 252         2070 return $result;
3323             } ## end if ( $self->{_use_c} && $self->{_c_nodes} ...)
3324              
3325             # Fallback: edge thresholds, c==0, or no C backend.
3326 17         81 my $scores = $self->score_samples( $self->_to_arrayref($data) );
3327 17 100       145 return [ map { $_ >= $threshold ? 1 : 0 } @$scores ];
  1285         2302  
3328             } ## end sub predict
3329              
3330             =head2 predict_tagged(\%row, $threshold)
3331              
3332             Predicts whether a single sample is an anomaly using a hashref of named
3333             feature values. The model must have been fitted (or loaded from a model
3334             that was fitted) with feature names stored via C.
3335              
3336             C<$threshold> defaults the same way as in C.
3337              
3338             Returns a scalar 1 (anomaly) or 0 (normal).
3339              
3340             my $label = $forest->predict_tagged(
3341             { cpu => 0.9, mem => 0.4, disk => 0.1 },
3342             );
3343              
3344             Croaks if the model has no stored feature names, if the hashref contains a
3345             key that is not a known feature name, or if a feature name is absent from the
3346             hashref.
3347              
3348             =cut
3349              
3350             =head2 tagged_row_to_array(\%row, $caller)
3351              
3352             Validates a hashref of named feature values against the model's stored
3353             C and returns a positional arrayref ready to pass to any
3354             of the scoring or prediction methods.
3355              
3356             C<$caller> is a string used in error messages to identify which method
3357             triggered the validation (pass the calling method's name).
3358              
3359             my $vec = $forest->tagged_row_to_array(\%row, 'my_method');
3360             # returns e.g. [0.9, 0.4, 0.1] ordered by feature_names
3361              
3362             Croaks if:
3363              
3364             =over 4
3365              
3366             =item * C<$row> is not a hashref
3367              
3368             =item * the model has no stored C
3369              
3370             =item * the hashref contains a key that is not a known feature name
3371              
3372             =item * a feature name is absent from the hashref
3373              
3374             =back
3375              
3376             =cut
3377              
3378             sub tagged_row_to_array {
3379 1013     1013 1 17033 my ( $self, $row, $caller ) = @_;
3380 1013 100       2617 croak "$caller requires a hashref"
3381             unless ref $row eq 'HASH';
3382              
3383             # With mungers configured the compiled plan owns the row assembly:
3384             # it knows the real input fields (munger 'from' sources included,
3385             # which need not be tags at all) and croaks on a missing one. Extra
3386             # keys are ignored -- with expanders and combiners in play, "the
3387             # exact key set" is the plan's knowledge, not feature_names'.
3388 1008 100       1419 if ( my $plan = _plan($self) ) {
3389 945         1047 my $vec = eval { $plan->apply_named($row) };
  945         1406  
3390 945 100       35417 croak "$caller: $@" if $@;
3391 944         1706 return $vec;
3392             }
3393              
3394             croak "this model has no stored feature_names; " . "refit with -t tags or pass feature_names to new()"
3395             unless defined $self->{feature_names}
3396             && ref $self->{feature_names} eq 'ARRAY'
3397 62 50 66     1125 && @{ $self->{feature_names} };
  57   66     182  
3398              
3399 57         97 my @names = @{ $self->{feature_names} };
  57         218  
3400              
3401             my @unknown = grep {
3402 57         195 my $k = $_;
  152         247  
3403 152         229 !grep { $_ eq $k } @names
  433         817  
3404             } keys %$row;
3405 57 100       1079 croak "unknown feature name(s) in hashref: " . join( ', ', sort @unknown )
3406             if @unknown;
3407              
3408 52         99 my @missing = grep { !exists $row->{$_} } @names;
  144         295  
3409 52 100       1401 croak "missing feature name(s) in hashref: " . join( ', ', @missing )
3410             if @missing;
3411              
3412 45         81 return [ map { $row->{$_} } @names ];
  126         341  
3413             } ## end sub tagged_row_to_array
3414              
3415             sub predict_tagged {
3416 12     12 1 19161 my ( $self, $row, $threshold ) = @_;
3417 12         36 my $vec = $self->tagged_row_to_array( $row, 'predict_tagged' );
3418 8         36 my $result = $self->predict( [$vec], $threshold );
3419 8         66 return $result->[0];
3420             }
3421              
3422             =head2 munge_rows(\@rows)
3423              
3424             Applies the model's scalar mungers to positional rows (arrayrefs in
3425             C order), returning a new arrayref of munged rows. A
3426             model without C returns the input unchanged, so callers such
3427             as the CLI can pass every dataset through unconditionally.
3428              
3429             Croaks if the munger set contains expanding or combining mungers --
3430             their inputs are named source fields that positional rows cannot
3431             express; use the tagged methods (or L) for those.
3432              
3433             my $numeric = $iforest->munge_rows(\@raw_rows);
3434              
3435             =cut
3436              
3437             sub munge_rows {
3438 6     6 1 2310 my ( $self, $rows ) = @_;
3439 6 50       25 croak "munge_rows() expects an arrayref of rows"
3440             unless ref $rows eq 'ARRAY';
3441 6         23 my $plan = _plan($self);
3442 6 50       32 return $rows unless $plan;
3443 6         13 my @out;
3444 6         21 for my $i ( 0 .. $#$rows ) {
3445 326         349 my $munged = eval { $plan->apply_positional( $rows->[$i] ) };
  326         500  
3446 326 100       9499 croak "munge_rows (row $i): $@" if $@;
3447 325         451 push @out, $munged;
3448             }
3449 5         20 return \@out;
3450             } ## end sub munge_rows
3451              
3452             =head2 score_samples(\@data)
3453              
3454             Returns an arrayref of anomaly scores, between 0 and 1.
3455              
3456             Scores near 1 are strong anomalies (isolated quickly).
3457              
3458             Scores well below 0.5 are normal.
3459              
3460             Scores ~0.5 means the points are hard to tell apart.
3461              
3462             Under C<< voting => 'majority' >> the returned value is instead the
3463             fraction of trees voting the sample anomalous at the model's decision
3464             threshold (the contamination-learned cutoff if present, otherwise 0.5) --
3465             still in [0, 1], but discrete in steps of C<1/n_trees>, with a majority
3466             label corresponding to a fraction strictly above 0.5.
3467              
3468             my $scores = $forest->score_samples(\@data);
3469              
3470             print "x, y, score\n";
3471              
3472             my $int=0;
3473             while (defined($data[$int])) {
3474             print $data[$int][0].', '.$data[$int][1].', '.$scores->[$int]."\n";
3475              
3476             $int++;
3477             }
3478              
3479             =cut
3480              
3481             sub score_samples {
3482 399     399 1 71669 my ( $self, $data ) = @_;
3483 399         1396 $self->_check_fitted;
3484 397         922 my $c = $self->{c_psi};
3485 397         683 my $trees = $self->{trees};
3486 397         765 my $t = scalar @$trees;
3487              
3488             # Majority voting: the "score" is the fraction of trees voting the
3489             # sample anomalous at the model's decision threshold (contamination-
3490             # learned if present, else 0.5) -- discrete in steps of 1/t.
3491 397 100       1046 if ( $self->{voting} eq 'majority' ) {
3492 9 50       23 my $theta = defined $self->{threshold} ? $self->{threshold} : 0.5;
3493 9         33 my $cut = _depth_cut( $theta, $c );
3494              
3495 9 50 66     41 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3496 7         30 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3497 7         20 my $votes_packed = "\0" x ( $n_pts * 8 );
3498             vote_all_xs( $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3499 7         33470 $x_packed, $votes_packed, $n_pts, $nf, $t, $cut, 0, $self->{_use_openmp} );
3500              
3501             # votes/t is exactly the "divide the sum buffer by t" shape
3502             # finalize_path_lengths_xs implements, so reuse it.
3503 7         67 my $result = [];
3504 7         82 finalize_path_lengths_xs( $votes_packed, $n_pts, $t + 0.0, $result );
3505 7         56 return $result;
3506             } ## end if ( $self->{_use_c} && $self->{_c_nodes} )
3507              
3508 2         12 my $votes = $self->_vote_counts_perl( $self->_prepare_perl_input($data), $cut );
3509 2         9 return [ map { $_ / $t } @$votes ] if _NV_IS_DOUBLE;
  126         227  
3510              
3511             # Wide-NV perls: the C finalizers divide in double, so narrow the
3512             # vote fraction to match -- see _NV_IS_DOUBLE.
3513 0         0 return [ map { _to_double( $_ / $t ) } @$votes ];
  0         0  
3514             } ## end if ( $self->{voting} eq 'majority' )
3515              
3516 388 100 100     1525 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3517 326         1013 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3518 325         943 my $sums_packed = "\0" x ( $n_pts * 8 );
3519             score_all_xs(
3520             $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3521             $x_packed, $sums_packed, $n_pts,
3522             $nf, $t, $self->{_use_openmp}
3523 325         1615679 );
3524 325 50       2072 if ( $c > 0 ) {
3525 325         1100 my $inv = log(2) / ( $c * $t );
3526 325         628 my $result = [];
3527 325         2354 finalize_scores_xs( $sums_packed, $n_pts, $inv, $result );
3528 325         2521 return $result;
3529             }
3530 0         0 return [ (0.5) x $n_pts ];
3531             } ## end if ( $self->{_use_c} && $self->{_c_nodes} )
3532              
3533 62         293 $data = $self->_prepare_perl_input($data);
3534 62 100       195 my $nan = $self->{missing} eq 'nan' ? 1 : 0;
3535              
3536             # Pure-Perl fallback (tree-outer, sample-inner for cache locality).
3537 62         379 my @sums = (0) x @$data;
3538 62         169 for my $tree (@$trees) {
3539 4582         7911 for my $i ( 0 .. $#$data ) {
3540 365236         498785 $sums[$i] += _path_length( $data->[$i], $tree, 0, $nan );
3541             }
3542             }
3543              
3544             # Precompute the single normalising factor; exp() is a direct FPU
3545             # instruction and faster than Perl's general-purpose 2**x (pow).
3546             # Derivation: 2**(-avg/c) = 2**(-(sum/t)/c) = exp(-sum * log(2)/(c*t))
3547 62 50       268 if ( $c > 0 ) {
3548 62         139 my $inv = log(2) / ( $c * $t );
3549 62         239 return [ map { exp( -$_ * $inv ) } @sums ];
  5019         7514  
3550             }
3551 0         0 return [ (0.5) x @sums ];
3552             } ## end sub score_samples
3553              
3554             =head2 score_sample_tagged(\%row)
3555              
3556             Scores a single sample supplied as a hashref of named feature values.
3557             The model must have stored feature names (set via C in
3558             C or the C<-t> CLI flag at fit time).
3559              
3560             Returns a scalar anomaly score in (0, 1].
3561              
3562             my $score = $forest->score_sample_tagged({ cpu => 0.9, mem => 0.4 });
3563              
3564             Croaks if the model has no stored feature names, if the hashref contains a
3565             key that is not a known feature name, or if a feature name is absent from the
3566             hashref.
3567              
3568             =cut
3569              
3570             sub score_sample_tagged {
3571 22     22 1 22581 my ( $self, $row ) = @_;
3572 22         85 my $vec = $self->tagged_row_to_array( $row, 'score_sample_tagged' );
3573 16         63 my $result = $self->score_samples( [$vec] );
3574 16         117 return $result->[0];
3575             }
3576              
3577             =head2 score_predict_samples
3578              
3579             Returns an array ref of arrays. First value of each sub array is the score with the second being
3580             0/1 for if it is a anomaly or not.
3581              
3582             C<$threshold> defaults the same way as in C.
3583              
3584             Under C<< voting => 'majority' >> the score is the anomaly vote fraction at
3585             C<$threshold> (used as the per-tree cutoff) and the label is the majority
3586             vote, matching C/C semantics in that mode.
3587              
3588             my $results = $forest->score_predict_samples(\@data, $threshold);
3589              
3590             print "x, y, score, result\n";
3591              
3592             my $int=0;
3593             while (defined($data[$int])) {
3594             print $data[$int][0].', '.$data[$int][1].', '.$results->[$int][0].', '.$results->[$int][1]."\n";
3595              
3596             $int++;
3597             }
3598              
3599             =cut
3600              
3601             sub score_predict_samples {
3602 142     142 1 12786 my ( $self, $data, $threshold ) = @_;
3603             $threshold
3604             = defined $threshold ? $threshold
3605             : defined $self->{threshold} ? $self->{threshold}
3606 142 100       376 : 0.5;
    100          
3607 142         458 $self->_check_fitted;
3608              
3609             # Majority voting: [vote_fraction, majority_label] pairs. Needs the
3610             # full vote counts (the fraction is part of the return shape), so no
3611             # early exit here -- that saving is predict()-only.
3612 142 100       454 if ( $self->{voting} eq 'majority' ) {
3613 3         9 my $trees = $self->{trees};
3614 3         6 my $t = scalar @$trees;
3615 3         14 my $cut = _depth_cut( $threshold, $self->{c_psi} );
3616 3         9 my $maj = _min_votes($t);
3617              
3618 3 50 33     18 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3619 3         12 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3620 3         12 my $votes_packed = "\0" x ( $n_pts * 8 );
3621             vote_all_xs( $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3622 3         11524 $x_packed, $votes_packed, $n_pts, $nf, $t, $cut, 0, $self->{_use_openmp} );
3623 3         14 my $result = [];
3624 3         86 vote_score_predict_xs( $votes_packed, $n_pts, $t + 0.0, $maj + 0.0, $result );
3625 3         17 return $result;
3626             }
3627              
3628 0         0 my $votes = $self->_vote_counts_perl( $self->_prepare_perl_input($data), $cut );
3629 0 0       0 return [ map { [ $_ / $t, ( $_ >= $maj ? 1 : 0 ) ] } @$votes ] if _NV_IS_DOUBLE;
  0         0  
3630              
3631             # Wide-NV perls: match vote_score_predict_xs's double division --
3632             # see _NV_IS_DOUBLE.
3633 0 0       0 return [ map { [ _to_double( $_ / $t ), ( $_ >= $maj ? 1 : 0 ) ] } @$votes ];
  0         0  
3634             } ## end if ( $self->{voting} eq 'majority' )
3635              
3636             # Fast path: build [score, label] pairs straight from the sum buffer
3637             # in one C call. Avoids the intermediate scores arrayref + Perl
3638             # foreach that allocates ~3*n_pts SVs. Gated identically to predict()
3639             # so the threshold conversion is valid.
3640 139 50 66     1120 if ( $self->{_use_c}
      33        
      33        
      33        
3641             && $self->{_c_nodes}
3642             && $self->{c_psi} > 0
3643             && $threshold > 0
3644             && $threshold < 1 )
3645             {
3646 137         235 my $trees = $self->{trees};
3647 137         245 my $t = scalar @$trees;
3648 137         235 my $c = $self->{c_psi};
3649 137         371 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3650 137         356 my $sums_packed = "\0" x ( $n_pts * 8 );
3651             score_all_xs(
3652             $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3653             $x_packed, $sums_packed, $n_pts,
3654             $nf, $t, $self->{_use_openmp}
3655 137         729108 );
3656 137         3392 my $inv = log(2) / ( $c * $t );
3657 137         434 my $sum_threshold = -log($threshold) * $c * $t / log(2);
3658 137         274 my $result = [];
3659 137         989 score_predict_xs( $sums_packed, $n_pts, $inv, $sum_threshold, $result );
3660 137         1216 return $result;
3661             } ## end if ( $self->{_use_c} && $self->{_c_nodes} ...)
3662              
3663             # Fallback: edge thresholds, c==0, or no C backend.
3664 2         9 my $scores = $self->score_samples( $self->_to_arrayref($data) );
3665              
3666 2         5 my @to_return;
3667 2         4 foreach my $score ( @{$scores} ) {
  2         6  
3668 12 100       17 if ( $score >= $threshold ) {
3669 4         10 push @to_return, [ $score, 1 ];
3670             } else {
3671 8         18 push @to_return, [ $score, 0 ];
3672             }
3673             }
3674              
3675 2         14 return \@to_return;
3676             } ## end sub score_predict_samples
3677              
3678             =head2 score_predict_sample_tagged(\%row, $threshold)
3679              
3680             Scores and classifies a single sample supplied as a hashref of named
3681             feature values. The model must have stored feature names.
3682              
3683             C<$threshold> defaults the same way as in C.
3684              
3685             Returns a two-element arrayref C<[$score, $label]>, matching the per-row
3686             shape that C returns for each row.
3687              
3688             my $pair = $forest->score_predict_sample_tagged({ cpu => 0.9, mem => 0.4 });
3689             printf "score %.4f anomaly %d\n", $pair->[0], $pair->[1];
3690              
3691             Croaks if the model has no stored feature names, if the hashref contains a
3692             key that is not a known feature name, or if a feature name is absent from the
3693             hashref.
3694              
3695             =cut
3696              
3697             sub score_predict_sample_tagged {
3698 21     21 1 36140 my ( $self, $row, $threshold ) = @_;
3699 21         59 my $vec = $self->tagged_row_to_array( $row, 'score_predict_sample_tagged' );
3700 17         57 my $result = $self->score_predict_samples( [$vec], $threshold );
3701 17         108 return $result->[0];
3702             }
3703              
3704             =head2 score_predict_split(\@data, $threshold)
3705              
3706             Same data as L but returned as two flat arrayrefs
3707             instead of an arrayref-of-pairs. Allocates roughly half as many Perl
3708             SVs per point (no inner AV, no RV per row), so it is meaningfully faster
3709             when both scores and labels are wanted but the paired shape is not.
3710              
3711             In list context returns C<($scores_aref, $labels_aref)>.
3712              
3713             my ($scores, $labels) = $forest->score_predict_split(\@data);
3714              
3715             for my $i (0 .. $#$scores) {
3716             printf "%s -> score %.4f, label %d\n",
3717             join(',', @{ $data[$i] }), $scores->[$i], $labels->[$i];
3718             }
3719              
3720             C<$threshold> defaults to the contamination-learned cutoff (if C
3721             was called with C) or 0.5.
3722              
3723             =cut
3724              
3725             sub score_predict_split {
3726 235     235 1 10434 my ( $self, $data, $threshold ) = @_;
3727             $threshold
3728             = defined $threshold ? $threshold
3729             : defined $self->{threshold} ? $self->{threshold}
3730 235 50       662 : 0.5;
    100          
3731 235         838 $self->_check_fitted;
3732              
3733             # Majority voting: same values as the majority branch in
3734             # score_predict_samples, returned as two flat arrayrefs.
3735 235 100       695 if ( $self->{voting} eq 'majority' ) {
3736 6         11 my $trees = $self->{trees};
3737 6         11 my $t = scalar @$trees;
3738 6         20 my $cut = _depth_cut( $threshold, $self->{c_psi} );
3739 6         15 my $maj = _min_votes($t);
3740              
3741 6 50 66     28 if ( $self->{_use_c} && $self->{_c_nodes} ) {
3742 4         16 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3743 4         13 my $votes_packed = "\0" x ( $n_pts * 8 );
3744             vote_all_xs( $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3745 4         16118 $x_packed, $votes_packed, $n_pts, $nf, $t, $cut, 0, $self->{_use_openmp} );
3746 4         18 my $scores = [];
3747 4         7 my $labels = [];
3748 4         112 vote_score_predict_split_xs( $votes_packed, $n_pts, $t + 0.0, $maj + 0.0, $scores, $labels );
3749 4         31 return ( $scores, $labels );
3750             } ## end if ( $self->{_use_c} && $self->{_c_nodes} )
3751              
3752 2         11 my $votes = $self->_vote_counts_perl( $self->_prepare_perl_input($data), $cut );
3753             my @scores = _NV_IS_DOUBLE
3754 126         220 ? map { $_ / $t }
3755             @$votes
3756             # Wide-NV perls: match vote_score_predict_split_xs's double
3757             # division -- see _NV_IS_DOUBLE.
3758 2         12 : map { _to_double( $_ / $t ) } @$votes;
3759 2 100       6 my @labels = map { $_ >= $maj ? 1 : 0 } @$votes;
  126         176  
3760 2         19 return ( \@scores, \@labels );
3761             } ## end if ( $self->{voting} eq 'majority' )
3762              
3763             # Fast path: fill two flat arrayrefs (scores + labels) directly from
3764             # the sum buffer in one C call. Skips the inner AV + RV per point
3765             # that score_predict_samples has to allocate.
3766 229 50 66     2003 if ( $self->{_use_c}
      33        
      33        
      33        
3767             && $self->{_c_nodes}
3768             && $self->{c_psi} > 0
3769             && $threshold > 0
3770             && $threshold < 1 )
3771             {
3772 227         407 my $trees = $self->{trees};
3773 227         489 my $t = scalar @$trees;
3774 227         519 my $c = $self->{c_psi};
3775 227         802 my ( $n_pts, $nf, $x_packed ) = $self->_resolve_input($data);
3776 227         554 my $sums_packed = "\0" x ( $n_pts * 8 );
3777             score_all_xs(
3778             $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val},
3779             $x_packed, $sums_packed, $n_pts,
3780             $nf, $t, $self->{_use_openmp}
3781 227         1204668 );
3782 227         1565 my $inv = log(2) / ( $c * $t );
3783 227         788 my $sum_threshold = -log($threshold) * $c * $t / log(2);
3784 227         531 my $scores = [];
3785 227         373 my $labels = [];
3786 227         1623 score_predict_split_xs( $sums_packed, $n_pts, $inv, $sum_threshold, $scores, $labels );
3787 227         2867 return ( $scores, $labels );
3788             } ## end if ( $self->{_use_c} && $self->{_c_nodes} ...)
3789              
3790             # Fallback: derive from score_samples.
3791 2         10 my $scores = $self->score_samples( $self->_to_arrayref($data) );
3792 2 100       8 my @labels = map { $_ >= $threshold ? 1 : 0 } @$scores;
  12         24  
3793 2         13 return ( $scores, \@labels );
3794             } ## end sub score_predict_split
3795              
3796             =head1 MUNGERS
3797              
3798             With the optional L module, a model can carry
3799             a declarative munger spec (see C under L) that
3800             turns raw tagged values -- strings, timestamps, status codes, IPs --
3801             into the numbers the forest needs, so callers hand the model the data
3802             they actually have:
3803              
3804             my $forest = Algorithm::Classifier::IsolationForest->new(
3805             feature_names => [ 'method', 'bytes_log', 'host_entropy' ],
3806             mungers => {
3807             method => { munger => 'http_method_enum', default => -1 },
3808             bytes_log => { munger => 'log', offset => 1, from => 'bytes' },
3809             host_entropy => { munger => 'entropy', from => 'host' },
3810             },
3811             );
3812             $forest->fit_tagged(\@raw_rows);
3813             my $score = $forest->score_sample_tagged(
3814             { method => 'POST', bytes => 51234, host => 'kq3xv9z2.example' } );
3815              
3816             The spec is pure data and is B, so a loaded model
3817             munges scoring input exactly as it did training input -- the
3818             consistency that makes munging part of the model rather than an
3819             upstream preprocessing step. Points worth knowing:
3820              
3821             =over 4
3822              
3823             =item * Only tagged input is munged. Positional rows passed to C
3824             or the scoring methods are taken as already numeric; L
3825             applies the scalar mungers to positional rows for callers (like the
3826             CLI) that want the same transformation there. Packed datasets
3827             (L) are never munged.
3828              
3829             =item * Under a munger plan, tagged-row validation is the plan's: a
3830             missing input field croaks (including munger C sources, which
3831             need not be tags), while unknown extra keys are ignored rather than
3832             rejected.
3833              
3834             =item * Loading a model that carries mungers does not require
3835             Algorithm::ToNumberMunger -- inspection and positional scoring work
3836             without it; the first tagged call croaks with an install hint. A
3837             munger name unknown to an older installed Algorithm::ToNumberMunger
3838             croaks naming it; the model records C (the
3839             version that authored the spec) to make that diagnosable.
3840              
3841             =item * Munging happens before the C strategy: for munged
3842             columns the strategy sees the munger's output, and most mungers define
3843             their own undef handling (C counts undef as 0, C takes a
3844             C, ...). Raw columns behave exactly as without mungers.
3845              
3846             =item * Caveats inherited from the munger set: the C munger talks
3847             to an external service, so a saved model using it needs that service
3848             reachable wherever the model runs; C/C count
3849             tables are part of the spec and therefore of the model file.
3850              
3851             =back
3852              
3853             The munger spec composes with everything else -- modes, voting,
3854             contamination, the C backend (munging is input-side; accelerated paths
3855             are unchanged) -- and works identically on
3856             L.
3857              
3858             =head1 MODEL SAVE/LOAD METHODS
3859              
3860             =head2 to_json
3861              
3862             Returns a JSON representation of the model.
3863              
3864             Requires fit to have been called.
3865              
3866             my $json = $iforest->to_json;
3867              
3868             =cut
3869              
3870             sub to_json {
3871 32     32 1 253606 my ($self) = @_;
3872 32         171 $self->_check_fitted;
3873             my $payload = {
3874             format => 'Algorithm::Classifier::IsolationForest',
3875             version => 1,
3876             params => {
3877             n_trees => $self->{n_trees},
3878             sample_size => $self->{sample_size},
3879             mode => $self->{mode},
3880             extension_level => $self->{extension_level_used},
3881             contamination => $self->{contamination},
3882             threshold => $self->{threshold},
3883             n_features => $self->{n_features},
3884             psi_used => $self->{psi_used},
3885             c_psi => $self->{c_psi},
3886             max_depth_used => $self->{max_depth_used},
3887             missing => $self->{missing},
3888             impute_with => $self->{impute_with},
3889             missing_fill => $self->{missing_fill},
3890             feature_names => $self->{feature_names},
3891             voting => $self->{voting},
3892             mungers => $self->{mungers},
3893             munger_module_version => $self->{munger_module_version},
3894             schema_version => $self->{schema_version},
3895             schema_description => $self->{schema_description},
3896             feature_descriptions => $self->{feature_descriptions},
3897             },
3898             trees => $self->{trees},
3899 30         860 };
3900 30         380 return JSON::PP->new->canonical(1)->encode($payload);
3901             } ## end sub to_json
3902              
3903             =head2 from_json($json)
3904              
3905             Init the object from the model in the specified JSON string.
3906              
3907             my $iforest = Algorithm::Classifier::IsolationForest->from_json($json);
3908              
3909             =cut
3910              
3911             sub from_json {
3912 55     55 1 4467917 my ( $class, $text ) = @_;
3913 55         707 my $payload = JSON::PP->new->decode($text);
3914             croak "not an IsolationForest model"
3915             unless ref $payload eq 'HASH'
3916 55 100 100     21438506 && defined $payload->{format};
3917              
3918             # Online models carry their own format tag; hand them to the class
3919             # that knows their shape so callers can load either model type
3920             # through this one entry point.
3921 53 100       310 if ( $payload->{format} eq 'Algorithm::Classifier::IsolationForest::Online' ) {
3922 14         1887 require Algorithm::Classifier::IsolationForest::Online;
3923 14         230 return Algorithm::Classifier::IsolationForest::Online->from_json($text);
3924             }
3925              
3926             croak "not an IsolationForest model"
3927 39 50       214 unless $payload->{format} eq 'Algorithm::Classifier::IsolationForest';
3928              
3929 39   100     174 my $p = $payload->{params} || {};
3930              
3931             # version 0 used hash-based nodes; version 1+ uses array-based nodes.
3932             # Convert old models on load so the rest of the code only sees arrays.
3933 39   50     153 my $trees = $payload->{trees} || [];
3934 39 100 100     316 if ( ( $payload->{version} // 0 ) < 1 ) {
3935 1         4 $trees = [ map { _hash_node_to_array($_) } @$trees ];
  0         0  
3936             }
3937              
3938             my $self = {
3939             n_trees => $p->{n_trees},
3940             sample_size => $p->{sample_size},
3941             max_depth => undef,
3942             seed => undef,
3943             mode => $p->{mode} // 'axis',
3944             extension_level => $p->{extension_level},
3945             extension_level_used => $p->{extension_level},
3946             contamination => $p->{contamination},
3947             threshold => $p->{threshold},
3948             n_features => $p->{n_features},
3949             psi_used => $p->{psi_used},
3950             c_psi => $p->{c_psi},
3951             max_depth_used => $p->{max_depth_used},
3952             # Models saved before missing-value support lack these keys; default
3953             # to 'zero', which reproduces the old undef -> 0 scoring behaviour.
3954             missing => $p->{missing} // 'zero',
3955             impute_with => $p->{impute_with} // 'mean',
3956             missing_fill => $p->{missing_fill},
3957             feature_names => $p->{feature_names},
3958             # The munger plan is recompiled lazily on first tagged use, so a
3959             # munger-bearing model still loads (and scores positional data)
3960             # where Algorithm::ToNumberMunger is not installed.
3961             mungers => $p->{mungers},
3962             munger_module_version => $p->{munger_module_version},
3963             # Opaque schema metadata; absent in models saved before prototype
3964             # support, which just means "none recorded".
3965             schema_version => $p->{schema_version},
3966             schema_description => $p->{schema_description},
3967             feature_descriptions => $p->{feature_descriptions},
3968             # Models saved before majority-voting support lack the key; 'mean'
3969             # reproduces their behaviour exactly.
3970 39   100     1522 voting => $p->{voting} // 'mean',
      100        
      100        
      100        
3971             trees => $trees,
3972             _use_c => $HAS_C,
3973             _use_openmp => $HAS_OPENMP,
3974             _use_openmp_fit => 0, # opt-in only; loaded models never re-fit implicitly
3975             };
3976 39 100       92 croak "model contains no trees" unless @{ $self->{trees} };
  39         305  
3977              
3978             # Recompute the normalising constant from the (integer, exact) sub-sample
3979             # size rather than trusting the stored float, so a reloaded model's scores
3980             # are bit-for-bit identical to the original's.
3981 38 50       308 $self->{c_psi} = _c( $self->{psi_used} ) if defined $self->{psi_used};
3982              
3983 38         159 my $model = bless $self, $class;
3984 38 50       685 $model->_rebuild_c_trees() if $self->{_use_c};
3985 38         639 return $model;
3986             } ## end sub from_json
3987              
3988             =head2 save($path)
3989              
3990             Saves the model to the specified path.
3991              
3992             $iforest->save($path);
3993              
3994             =cut
3995              
3996             sub save {
3997 3     3 1 4654 my ( $self, $path ) = @_;
3998 3         25 write_file( $path, { 'atomic' => 1 }, $self->to_json );
3999             }
4000              
4001             =head2 load($path)
4002              
4003             Init the object from the model in the specified file.
4004              
4005             my $iforest = Algorithm::Classifier::IsolationForest->load($path);
4006              
4007             =cut
4008              
4009             sub load {
4010 38     38 1 440227 my ( $class, $path ) = @_;
4011 38         272 my $raw_model = read_file($path);
4012 37         5160 return $class->from_json($raw_model);
4013             }
4014              
4015             =head1 PROTOTYPES
4016              
4017             A prototype is a small JSON document that describes what a model should
4018             be before any data exists: the variable schema (feature names in column
4019             order, plus their munger specs, per-feature descriptions, and missing
4020             policy), a user-owned C string, a human-readable
4021             C, and optionally the tuning knobs. Creating a
4022             model from one -- L here, or
4023             C<--prototype> on C / C -- stamps the
4024             schema metadata into the model JSON, so every downstream consumer
4025             (C, resumed streams, your own tooling) can tell which
4026             revision of the input schema a model was built against.
4027              
4028             {
4029             "format": "Algorithm::Classifier::IsolationForest::Prototype",
4030             "version": 1,
4031             "class": "online",
4032             "schema_version": "2026.07.08-1",
4033             "schema_description": "HTTP request stream: method enum, path length, host entropy, raw byte count",
4034             "schema": {
4035             "feature_names": ["method", "path_len", "host_entropy", "bytes"],
4036             "feature_descriptions": {
4037             "method": "HTTP request method, mapped via http_method_enum (-1 = unknown)",
4038             "path_len": "character length of the request path",
4039             "host_entropy": "Shannon entropy of the Host header",
4040             "bytes": "raw response byte count, passed through unmunged"
4041             },
4042             "mungers": {
4043             "method": { "munger": "http_method_enum", "default": -1 },
4044             "path_len": { "munger": "length", "from": "path" },
4045             "host_entropy": { "munger": "entropy", "from": "host" }
4046             },
4047             "missing": "zero"
4048             },
4049             "params": {
4050             "n_trees": 150,
4051             "window_size": 4096,
4052             "max_leaf_samples": 32,
4053             "contamination": 0.02
4054             }
4055             }
4056              
4057             The fields, top to bottom...
4058              
4059             - format :: required, always the string
4060             'Algorithm::Classifier::IsolationForest::Prototype'. A prototype
4061             handed to load() (or a model handed to the prototype methods)
4062             dies with a clear message instead of half-working.
4063              
4064             - version :: the prototype format version; this release reads version 1.
4065             default :: 1
4066              
4067             - class :: required, 'batch' (this class) or 'online'
4068             (L). Prototypes
4069             are self-describing; `iforest fit` refuses an online prototype
4070             and `iforest stream` refuses a batch one. Two model types with
4071             the same variables means two prototype files.
4072              
4073             - schema_version :: required opaque string, never parsed or compared
4074             numerically. User-owned: bump it when the variable schema
4075             changes.
4076              
4077             - schema_description :: required opaque free-text string describing
4078             what this variable schema is, so a model file explains itself
4079             months later.
4080              
4081             - schema :: required object holding the variable schema.
4082             feature_names is required (order = CSV column order); the
4083             optional keys are feature_descriptions ('feature name => free
4084             text', every key must name an entry in feature_names, partial
4085             coverage fine), mungers (see L), missing, and -- batch
4086             prototypes only -- impute_with. Unknown keys croak.
4087              
4088             - params :: optional object of tuning knobs, whitelisted per class.
4089             Batch: n_trees, sample_size, max_depth, mode, extension_level,
4090             contamination, voting, seed. Online: n_trees, window_size,
4091             max_leaf_samples, growth, subsample, contamination, seed.
4092             Unknown keys croak -- a typo'd knob silently falling back to its
4093             default is exactly the failure mode a prototype exists to
4094             prevent. Machine-local knobs (use_c, use_openmp, use_openmp_fit,
4095             parallel_fit) are rejected: they describe the box the model runs
4096             on, not the model.
4097              
4098             =cut
4099              
4100             # Per-class whitelists for a prototype's params block (and
4101             # new_from_prototype's %overrides) and its schema block. Machine-local
4102             # knobs are deliberately absent from the params lists.
4103             my %PROTO_PARAM_KEYS = (
4104             batch => { map { $_ => 1 } qw(n_trees sample_size max_depth mode extension_level contamination voting seed) },
4105             online => { map { $_ => 1 } qw(n_trees window_size max_leaf_samples growth subsample contamination seed) },
4106             );
4107             my %PROTO_SCHEMA_KEYS = (
4108             batch => { map { $_ => 1 } qw(feature_names feature_descriptions mungers missing impute_with) },
4109             online => { map { $_ => 1 } qw(feature_names feature_descriptions mungers missing) },
4110             );
4111              
4112             =head2 validate_prototype($proto)
4113              
4114             Structurally validates a prototype -- a hashref or a JSON string -- and
4115             returns the decoded hashref; croaks describing the first problem found.
4116             Validation is structural only (no munger compilation), so it does not
4117             require Algorithm::ToNumberMunger even for a munger-bearing prototype.
4118              
4119             my $proto = Algorithm::Classifier::IsolationForest->validate_prototype($json);
4120              
4121             =cut
4122              
4123             sub validate_prototype {
4124 53     53 1 32556 my ( $class, $proto ) = @_;
4125              
4126 53 100       198 if ( !ref $proto ) {
4127 16         30 my $decoded = eval { JSON::PP->new->decode($proto) };
  16         122  
4128 16 100       34985 croak "prototype did not parse as JSON: $@" if $@;
4129 15         43 $proto = $decoded;
4130             }
4131 52 100       303 croak "not an IsolationForest prototype (expected a JSON object)"
4132             unless ref $proto eq 'HASH';
4133             croak "not an IsolationForest prototype (format is not " . "'Algorithm::Classifier::IsolationForest::Prototype')"
4134             unless defined $proto->{format}
4135             && !ref $proto->{format}
4136 51 100 33     548 && $proto->{format} eq 'Algorithm::Classifier::IsolationForest::Prototype';
      66        
4137              
4138 50   100     190 my $version = $proto->{version} // 1;
4139 50 100 33     719 croak "prototype format version '$version' is newer than this module understands (max 1)"
      66        
4140             if !ref $version && $version =~ /^\d+$/ && $version > 1;
4141              
4142 49         343 for my $k ( sort keys %$proto ) {
4143 319 100       1333 croak "prototype has unknown top-level key '$k'"
4144             unless $k =~ /\A(?:format|version|class|schema_version|schema_description|schema|params)\z/;
4145             }
4146              
4147 48         140 my $which = $proto->{class};
4148 48 100 66     681 croak "prototype needs a class of 'batch' or 'online'"
      100        
4149             unless defined $which && !ref $which && $which =~ /\A(?:batch|online)\z/;
4150              
4151 46         111 for my $req (qw(schema_version schema_description)) {
4152             croak "prototype needs a non-empty $req string"
4153 89 100 66     1265 unless defined $proto->{$req} && !ref $proto->{$req} && length $proto->{$req};
      100        
4154             }
4155              
4156 42         84 my $schema = $proto->{schema};
4157 42 100       246 croak "prototype needs a schema object" unless ref $schema eq 'HASH';
4158 41         166 for my $k ( sort keys %$schema ) {
4159             croak "prototype schema has unknown key '$k' for a $which prototype (allowed: "
4160 2         331 . join( ', ', sort keys %{ $PROTO_SCHEMA_KEYS{$which} } ) . ')'
4161 90 100       274 unless $PROTO_SCHEMA_KEYS{$which}{$k};
4162             }
4163 39         83 my $tags = $schema->{feature_names};
4164 39 100 100     451 croak "prototype schema needs a non-empty feature_names array"
4165             unless ref $tags eq 'ARRAY' && @$tags;
4166 37         81 for my $t (@$tags) {
4167 80 100 66     559 croak "prototype feature_names entries must be non-empty strings"
      66        
4168             unless defined $t && !ref $t && length $t;
4169             }
4170             _validate_feature_descriptions( $tags, $schema->{feature_descriptions} )
4171 36 100       169 if defined $schema->{feature_descriptions};
4172             croak "prototype schema mungers must be an object of 'tag => munger spec'"
4173 35 100 100     310 if defined $schema->{mungers} && ref $schema->{mungers} ne 'HASH';
4174 34         96 for my $str (qw(missing impute_with)) {
4175             croak "prototype schema $str must be a plain string"
4176 68 50 66     227 if defined $schema->{$str} && ref $schema->{$str};
4177             }
4178              
4179 34         64 my $params = $proto->{params};
4180 34 100 66     322 croak "prototype params must be an object of tuning knobs"
4181             if defined $params && ref $params ne 'HASH';
4182 33 50       60 for my $k ( sort keys %{ $params || {} } ) {
  33         182  
4183             croak "prototype params has unknown key '$k' for a $which prototype (allowed: "
4184 3         594 . join( ', ', sort keys %{ $PROTO_PARAM_KEYS{$which} } )
4185             . '; machine-local knobs like use_c are deliberately not allowed)'
4186 99 100       292 unless $PROTO_PARAM_KEYS{$which}{$k};
4187             }
4188              
4189 30         151 return $proto;
4190             } ## end sub validate_prototype
4191              
4192             =head2 new_from_prototype($proto, %overrides)
4193              
4194             Creates a fresh, unfitted model from a prototype (a hashref or a JSON
4195             string) and returns it -- an instance of whichever class the prototype's
4196             C field names, so like C this is a single entry point for
4197             both model types. Croaks on any validation failure; a munger-bearing
4198             prototype compiles its plan here, so a bogus munger spec dies at
4199             creation (and needs Algorithm::ToNumberMunger installed).
4200              
4201             C<%overrides> merge over the prototype's C block -- per-run
4202             knobs like C -- and are held to the same per-class whitelist.
4203             Overriding the schema itself (feature_names, feature_descriptions,
4204             mungers, missing, impute_with, schema_version, schema_description)
4205             croaks: the schema is the prototype's, full stop; edit the prototype.
4206              
4207             my $oif = Algorithm::Classifier::IsolationForest->new_from_prototype(
4208             $proto_json,
4209             seed => 42,
4210             );
4211              
4212             =cut
4213              
4214             sub new_from_prototype {
4215 17     17 1 107578 my ( $class, $proto, %overrides ) = @_;
4216              
4217 17         71 $proto = $class->validate_prototype($proto);
4218 17         45 my $which = $proto->{class};
4219 17         35 my $schema = $proto->{schema};
4220              
4221 17         50 for my $k ( sort keys %overrides ) {
4222 15 100       269 croak "new_from_prototype: '$k' is part of the prototype's schema and may not "
4223             . "be overridden; edit the prototype instead"
4224             if $k
4225             =~ /\A(?:feature_names|feature_descriptions|mungers|missing|impute_with|schema_version|schema_description)\z/;
4226             croak "new_from_prototype: unknown override '$k' for a $which prototype (allowed: "
4227 1         157 . join( ', ', sort keys %{ $PROTO_PARAM_KEYS{$which} } ) . ')'
4228 14 100       46 unless $PROTO_PARAM_KEYS{$which}{$k};
4229             }
4230              
4231             my %args = (
4232 15 50       146 %{ $proto->{params} || {} },
4233             %overrides,
4234             feature_names => $schema->{feature_names},
4235             schema_version => $proto->{schema_version},
4236             schema_description => $proto->{schema_description},
4237 15         36 );
4238 15         43 for my $k (qw(feature_descriptions mungers missing impute_with)) {
4239 60 100       144 $args{$k} = $schema->{$k} if defined $schema->{$k};
4240             }
4241              
4242 15 100       48 if ( $which eq 'online' ) {
4243 7         67 require Algorithm::Classifier::IsolationForest::Online;
4244 7         68 return Algorithm::Classifier::IsolationForest::Online->new(%args);
4245             }
4246 8         47 return Algorithm::Classifier::IsolationForest->new(%args);
4247             } ## end sub new_from_prototype
4248              
4249             =head2 load_prototype($path, %overrides)
4250              
4251             L from a file.
4252              
4253             my $iforest = Algorithm::Classifier::IsolationForest->load_prototype(
4254             'proto.json', seed => 42 );
4255              
4256             =cut
4257              
4258             sub load_prototype {
4259 1     1 1 5565 my ( $class, $path, %overrides ) = @_;
4260 1         7 my $raw = read_file($path);
4261 1         201 return $class->new_from_prototype( $raw, %overrides );
4262             }
4263              
4264             =head2 to_prototype
4265              
4266             Returns a prototype JSON string extracted from this model: its variable
4267             schema (feature_names, feature_descriptions, mungers, missing policy)
4268             plus its current tuning knobs. This closes the loop -- extract a
4269             prototype from a good model and periodically create fresh models with an
4270             identical schema, the natural retrain workflow -- and means hand-writing
4271             a prototype is never mandatory.
4272              
4273             Croaks when the model has no C: a prototype's variable
4274             schema needs named variables. A model with no recorded
4275             C / C (fitted before prototype
4276             support, or without the knobs) gets placeholder values, since both are
4277             required in the file -- edit them in and bump from there. C and
4278             C resolved at fit time are not emitted; pass such per-run
4279             knobs as overrides when creating from the prototype.
4280              
4281             my $proto_json = $iforest->to_prototype;
4282              
4283             =cut
4284              
4285             sub to_prototype {
4286 4     4 1 68 my ($self) = @_;
4287             croak "to_prototype: this model has no feature_names; a prototype's variable " . "schema needs named features"
4288 4 100 66     261 unless ref $self->{feature_names} eq 'ARRAY' && @{ $self->{feature_names} };
  3         16  
4289              
4290             my $schema = {
4291             feature_names => $self->{feature_names},
4292             missing => $self->{missing},
4293 3         20 };
4294             $schema->{feature_descriptions} = $self->{feature_descriptions}
4295 3 100 66     16 if ref $self->{feature_descriptions} eq 'HASH' && %{ $self->{feature_descriptions} };
  1         7  
4296             $schema->{mungers} = $self->{mungers}
4297 3 50 33     23 if ref $self->{mungers} eq 'HASH' && %{ $self->{mungers} };
  0         0  
4298             $schema->{impute_with} = $self->{impute_with}
4299 3 50 33     21 if defined $self->{missing} && $self->{missing} eq 'impute';
4300              
4301             my $params = {
4302             n_trees => $self->{n_trees},
4303             sample_size => $self->{sample_size},
4304             mode => $self->{mode},
4305             voting => $self->{voting},
4306 3         20 };
4307 3 50       13 $params->{max_depth} = $self->{max_depth} if defined $self->{max_depth};
4308             $params->{extension_level} = $self->{extension_level_used} // $self->{extension_level}
4309 3 50 0     20 if defined( $self->{extension_level_used} // $self->{extension_level} );
      33        
4310 3 100       17 $params->{contamination} = $self->{contamination} if defined $self->{contamination};
4311              
4312             return JSON::PP->new->canonical(1)->encode(
4313             {
4314             format => 'Algorithm::Classifier::IsolationForest::Prototype',
4315             version => 1,
4316             class => 'batch',
4317             schema_version => $self->{schema_version} // '0',
4318             schema_description => $self->{schema_description}
4319 3   100     31 // '(none recorded; describe this schema and bump schema_version)',
      100        
4320             schema => $schema,
4321             params => $params,
4322             }
4323             );
4324             } ## end sub to_prototype
4325              
4326             =head1 REFERENCES
4327              
4328             Liu, Fei Tony & Ting, Kai & Zhou, Zhi-Hua. (2008). Isolation Forest. 413 - 422. 10.1109/ICDM.2008.17.
4329              
4330             L
4331              
4332             L
4333              
4334             Sahand Hariri, Matias Carrasco Kind, Robert J. Brunner (2020). Extended Isolation Forest. 1479 - 1489. 10.1109/TKDE.2019.2947676
4335              
4336             L
4337              
4338             Yousra Chabchoub, Maurras Ulbricht Togbe, Aliou Boly, Raja Chiky (2022). An In-Depth Study and Improvement of Isolation Forest. IEEE Access, vol. 10, 10219 - 10237. 10.1109/ACCESS.2022.3144425 (the Majority Voting Isolation Forest implemented by C<< voting => 'majority' >>)
4339              
4340             L
4341              
4342             Filippo Leveni, Guilherme Weigert Cassales, Bernhard Pfahringer, Albert Bifet, Giacomo Boracchi (2024). Online Isolation Forest. (the streaming variant implemented by L)
4343              
4344             L
4345              
4346             L
4347              
4348             L
4349              
4350             =cut
4351              
4352             ###
4353             ###
4354             ### internal stuff below
4355             ###
4356             ###
4357              
4358             #-------------------------------------------------------------------------------
4359             # c(n): the expected path length of an unsuccessful search in a binary search
4360             # tree of n nodes. Isolation Forest uses it (a) to adjust the path length when a
4361             # leaf still holds more than one point (depth limit reached), and (b) to
4362             # normalise the average path length into a 0..1 anomaly score.
4363             #-------------------------------------------------------------------------------
4364             sub _c {
4365 734595     734595   889843 my ($n) = @_;
4366 734595 100       1219115 return 0.0 if $n <= 1;
4367 430532 100       634008 return 1.0 if $n == 2;
4368 357436         454411 my $harmonic = log( $n - 1 ) + EULER; # H(n-1) ~= ln(n-1) + gamma
4369 357436         676666 return 2.0 * $harmonic - ( 2.0 * ( $n - 1 ) / $n );
4370             }
4371              
4372             #-------------------------------------------------------------------------------
4373             # Majority-voting (voting => 'majority') helpers. MVIForest -- Chabchoub,
4374             # Togbe, Boly & Chiky 2022 (see REFERENCES) -- has each tree vote a point
4375             # anomalous when the tree's own score 2**(-h/c(psi)) clears the decision
4376             # threshold, and takes the majority of the votes as the label. Trees are
4377             # untouched; only these scoring-time aggregation helpers differ from the
4378             # classic mean-path-length pipeline.
4379             #-------------------------------------------------------------------------------
4380              
4381             # Depth-domain image of the per-tree score cutoff: a tree votes a point
4382             # anomalous when 2**(-h/c) >= theta, i.e. h <= -c * log2(theta). Doing the
4383             # log once here keeps exp/log out of the per-point per-tree loops (both C
4384             # and Perl compare raw path lengths against this cut). Degenerate inputs
4385             # pin the cut so `h <= cut` still behaves: theta <= 0 is cleared by every
4386             # per-tree score (all in (0, 1]), so +inf lets every tree vote; c <= 0 only
4387             # happens for psi <= 1 forests, whose score convention is a flat 0.5 (see
4388             # score_samples), so all trees vote iff theta is at or below that pivot.
4389             sub _depth_cut {
4390 36     36   90 my ( $theta, $c ) = @_;
4391 36 0       102 return ( $theta <= 0.5 ? 9**9**9 : -1.0 ) if $c <= 0;
    50          
4392 36 50       83 return 9**9**9 if $theta <= 0;
4393 36         146 return -$c * log($theta) / log(2);
4394             }
4395              
4396             # Smallest number of per-tree anomaly votes that constitutes a majority:
4397             # int(t/2) + 1, i.e. strictly more than half the trees for both odd and
4398             # even tree counts (the paper's "t/2 + 1").
4399 36     36   119 sub _min_votes { return int( $_[0] / 2 ) + 1 }
4400              
4401             #-------------------------------------------------------------------------------
4402             # Contamination threshold selection: given the training scores ranked
4403             # descending and the target flag count k, return a cutoff sitting midway
4404             # inside the gap between the last flagged and the first unflagged score.
4405             #
4406             # Tied scores at the k-boundary make an exact count of k unattainable (the
4407             # tie block can only go one way or the other) AND make the naive midpoint
4408             # degenerate -- it equals the tied value, leaving predict()'s >= comparison
4409             # balanced on exact float equality. Mean-mode scores are continuous enough
4410             # that this practically never happens, but majority-mode pivots are
4411             # structurally quantized (path lengths at the depth cap take few distinct
4412             # values -- see _majority_pivot_scores), so ties there are the norm, and
4413             # the score <-> depth-cut conversion adds an exp/log round trip that needs
4414             # real slack around the cutoff rather than exact-equality behaviour. The
4415             # whole tie block therefore goes to whichever side lands the flag count
4416             # closest to k, preferring the flagging side on a dead heat.
4417             #-------------------------------------------------------------------------------
4418             sub _threshold_from_ranked {
4419 23     23   66 my ( $desc, $k ) = @_;
4420 23         51 my $n = scalar @$desc;
4421 23 50       301 return $desc->[ $n - 1 ] - 1e-9 if $k >= $n; # flag everything
4422              
4423 23         72 my $v = $desc->[ $k - 1 ];
4424 23 100       150 return ( $v + $desc->[$k] ) / 2.0 if $desc->[$k] < $v; # clean gap at k
4425              
4426             # Tie block straddling the k-boundary: locate its edges.
4427 6         21 my $i = $k - 1;
4428 6   66     86 $i-- while $i > 0 && $desc->[ $i - 1 ] == $v; # first index holding $v
4429 6         11 my $j = $k;
4430 6   66     122 $j++ while $j < $n && $desc->[$j] == $v; # first index below $v
4431              
4432 6 100 66     46 if ( $i > 0 && ( $k - $i ) < ( $j - $k ) ) {
4433              
4434             # Excluding the block lands closer to k: flag the $i points above it.
4435 4         25 return ( $desc->[ $i - 1 ] + $v ) / 2.0;
4436             }
4437 2 50       23 return $j < $n
4438             ? ( $v + $desc->[$j] ) / 2.0 # include the block: flag $j
4439             : $desc->[ $n - 1 ] - 1e-9; # block runs to the end
4440             } ## end sub _threshold_from_ranked
4441              
4442             # Pure-Perl vote counter: votes[i] = how many trees give point i a path
4443             # length at or under the depth cut. Tree-outer / sample-inner for cache
4444             # locality, mirroring the mean-mode fallback loops. $data must already
4445             # be through _prepare_perl_input.
4446             sub _vote_counts_perl {
4447 4     4   11 my ( $self, $data, $cut ) = @_;
4448 4         9 my $trees = $self->{trees};
4449 4 50       18 my $nan = $self->{missing} eq 'nan' ? 1 : 0;
4450 4         42 my @votes = (0) x @$data;
4451 4         14 for my $tree (@$trees) {
4452 160         279 for my $i ( 0 .. $#$data ) {
4453 10080 100       13430 $votes[$i]++ if _path_length( $data->[$i], $tree, 0, $nan ) <= $cut;
4454             }
4455             }
4456 4         19 return \@votes;
4457             } ## end sub _vote_counts_perl
4458              
4459             #-------------------------------------------------------------------------------
4460             # Contamination support for majority voting: each training point's majority
4461             # pivot -- the per-tree score threshold at which the point loses its
4462             # majority. A point is flagged at cutoff theta iff at least min_votes of
4463             # its per-tree path lengths h satisfy h <= -c*log2(theta), which holds iff
4464             # its min_votes-th SMALLEST path length h_(maj) does, i.e. iff
4465             # 2**(-h_(maj)/c) >= theta. So the pivot m = 2**(-h_(maj)/c) relates to
4466             # the majority-mode threshold exactly as the mean-mode score relates to
4467             # its threshold, and fit()'s midpoint selection works on either unchanged.
4468             #
4469             # Pure Perl by necessity: the per-tree path lengths never cross the C
4470             # boundary individually (score_all_xs/vote_all_xs only return per-point
4471             # aggregates), and fit() has already dropped any stale packed buffers when
4472             # this runs -- the same situation as mean mode's training-set scoring pass.
4473             #-------------------------------------------------------------------------------
4474             # Learn the contamination cutoff for the CURRENT voting mode from a training
4475             # set. Ranks the per-point quantity the active aggregation thresholds against
4476             # -- the mean-mode anomaly score, or the majority pivot under
4477             # voting => 'majority' -- and lands the cutoff midway inside a real gap between
4478             # flagged and unflagged values (ties at the k-boundary shift it to the nearest
4479             # gap; see _threshold_from_ranked), so it sits strictly between attainable
4480             # values: unambiguous and robust to the float rounding JSON introduces. A
4481             # point is flagged iff its statistic >= threshold in either mode, so the
4482             # midpoint selection serves both unchanged. Shared by fit() (which passes the
4483             # prepared training set after dropping any stale packed buffers) and
4484             # set_voting() (which passes the caller-supplied training set against the
4485             # live, fully packed forest); $data may hold raw undef cells either way, since
4486             # the scorers below densify from missing_fill.
4487             sub _learn_contamination_threshold {
4488 17     17   49 my ( $self, $data ) = @_;
4489             my $scores
4490 17 100       119 = $self->{voting} eq 'majority'
4491             ? $self->_majority_pivot_scores($data)
4492             : $self->score_samples($data);
4493 17         168 my @desc = sort { $b <=> $a } @$scores;
  11562         13132  
4494 17         68 my $n_pts = scalar @desc;
4495 17         95 my $k = int( $self->{contamination} * $n_pts + 0.5 );
4496 17 50       63 $k = 1 if $k < 1;
4497 17 50       80 $k = $n_pts if $k > $n_pts;
4498 17         105 $self->{threshold} = _threshold_from_ranked( \@desc, $k );
4499 17         150 return;
4500             } ## end sub _learn_contamination_threshold
4501              
4502             sub _majority_pivot_scores {
4503 9     9   24 my ( $self, $data ) = @_;
4504 9         19 my $trees = $self->{trees};
4505 9         18 my $t = scalar @$trees;
4506 9         19 my $c = $self->{c_psi};
4507 9         36 my $maj = _min_votes($t);
4508 9         59 my $rows = $self->_prepare_perl_input($data);
4509 9 50       28 my $nan = $self->{missing} eq 'nan' ? 1 : 0;
4510              
4511             # psi <= 1 degenerate forest: every per-tree score is pinned at 0.5
4512             # (matching score_samples' convention), so every pivot is too.
4513 9 50       26 return [ (0.5) x @$rows ] unless $c > 0;
4514              
4515 9         21 my $inv = log(2) / $c;
4516 9         20 my @pivots;
4517 9         23 for my $x (@$rows) {
4518 828         1820 my @paths = sort { $a <=> $b } map { _path_length( $x, $_, 0, $nan ) } @$trees;
  211443         238323  
  44010         57866  
4519 828         5188 push @pivots, exp( -$paths[ $maj - 1 ] * $inv );
4520             }
4521 9         57 return \@pivots;
4522             } ## end sub _majority_pivot_scores
4523              
4524             # One draw from the standard normal N(0,1) via Box-Muller. Used to pick the
4525             # random hyperplane orientations in Extended Isolation Forest mode.
4526             sub _randn {
4527 43954   50 43954   65285 my $u1 = rand() || 1e-12;
4528 43954         49058 my $u2 = rand();
4529 43954         72407 return sqrt( -2.0 * log($u1) ) * cos( TWO_PI * $u2 ) if _NV_IS_DOUBLE;
4530              
4531             # Wide-NV perls: round after every operation _c_randn() performs in
4532             # double, so both backends draw the same coefficient bit patterns
4533             # (up to libm's own double-vs-long-double disagreements on rare
4534             # rounding ties).
4535 0         0 my $s = _to_double( sqrt( -2.0 * _to_double( log($u1) ) ) );
4536 0         0 my $c = _to_double( cos( _to_double( TWO_PI * $u2 ) ) );
4537 0         0 return _to_double( $s * $c );
4538             } ## end sub _randn
4539              
4540             #-------------------------------------------------------------------------------
4541             # Draw $k samples without replacement via a partial Fisher-Yates shuffle of the
4542             # index array. Returns an arrayref of (shared, read-only) sample refs.
4543             #-------------------------------------------------------------------------------
4544             sub _subsample {
4545 2249     2249   4821 my ( $data, $k ) = @_;
4546 2249         3442 my $n = scalar @$data;
4547 2249         15764 my @idx = ( 0 .. $n - 1 );
4548 2249         5478 for my $i ( 0 .. $k - 1 ) {
4549 395208         469373 my $j = $i + int( rand( $n - $i ) );
4550 395208         529148 @idx[ $i, $j ] = @idx[ $j, $i ];
4551             }
4552 2249         36592 my @chosen = @idx[ 0 .. $k - 1 ];
4553 2249         10368 return [ @{$data}[@chosen] ];
  2249         44385  
4554             } ## end sub _subsample
4555              
4556             #-------------------------------------------------------------------------------
4557             # Recursively build one isolation tree.
4558             #
4559             # A node is one of:
4560             # leaf { leaf => 1, size => N }
4561             # axis { attr => A, split => S, left => ..., right => ... }
4562             # oblique { idx => [..], coef => [..], b => B, left => ..., right => ... }
4563             #
4564             # In both split styles the choice is restricted to features that actually vary
4565             # across the points reaching the node: this avoids wasted levels on constant
4566             # columns and lets a node leaf out exactly when its points are indistinguishable.
4567             #-------------------------------------------------------------------------------
4568             sub _build_tree {
4569 295267     295267   406194 my ( $self, $X, $depth, $limit ) = @_;
4570              
4571 295267         338963 my $size = scalar @$X;
4572 295267 100 100     677335 return [ _NODE_LEAF, $size ]
4573             if $depth >= $limit || $size <= 1;
4574              
4575 149304         190567 my $nf = $self->{n_features};
4576 149304         197360 my $nan = $self->{missing} eq 'nan';
4577              
4578             # Per-feature min and max within this node, in a single pass. Missing
4579             # (undef) cells never reach here under die/zero/impute -- those fill the
4580             # data before fit -- so the "next unless defined" guard is only needed
4581             # in nan mode, where missing values must not constrain a feature's
4582             # range; every other strategy skips it since every cell is defined and
4583             # the check would never fire.
4584 149304         174591 my ( @lo, @hi );
4585 149304 100       191204 if ($nan) {
4586 23338         29959 for my $row (@$X) {
4587 383160         461707 for my $f ( 0 .. $nf - 1 ) {
4588 770777         842641 my $v = $row->[$f];
4589 770777 100       993243 next unless defined $v;
4590 698528 100 100     1396742 $lo[$f] = $v if !defined $lo[$f] || $v < $lo[$f];
4591 698528 100 100     1488960 $hi[$f] = $v if !defined $hi[$f] || $v > $hi[$f];
4592             }
4593             }
4594             } else {
4595 125966         159796 for my $row (@$X) {
4596 2601022         3208874 for my $f ( 0 .. $nf - 1 ) {
4597 7058414         7865232 my $v = $row->[$f];
4598 7058414 100 100     13772658 $lo[$f] = $v if !defined $lo[$f] || $v < $lo[$f];
4599 7058414 100 100     14712342 $hi[$f] = $v if !defined $hi[$f] || $v > $hi[$f];
4600             }
4601             }
4602             }
4603              
4604             # Features with spread are the only ones that can split the data. A
4605             # feature whose values are all missing within this node has an undef
4606             # range and is excluded.
4607 149304 100       233627 my @varying = grep { defined $lo[$_] && $lo[$_] < $hi[$_] } 0 .. $nf - 1;
  333736         744047  
4608              
4609             # No spread on any feature => all points identical => cannot isolate.
4610 149304 100       225673 return [ _NODE_LEAF, $size ] unless @varying;
4611              
4612             my $node
4613 146509 100       298365 = $self->{mode} eq 'extended'
4614             ? $self->_oblique_split( $X, \@varying, \@lo, \@hi, $nan )
4615             : _axis_split( $X, \@varying, \@lo, \@hi, $nan );
4616              
4617             # Split functions leave the raw point arrays at the child slots so that
4618             # _build_tree can recurse into them; the subtree refs replace them in-place.
4619             # Axis nodes: left at [3], right at [4]
4620             # Oblique nodes: left at [4], right at [5]
4621 146509 100       247089 my ( $li, $ri ) = $node->[0] == _NODE_AXIS ? ( 3, 4 ) : ( 4, 5 );
4622 146509         268274 $node->[$li] = $self->_build_tree( $node->[$li], $depth + 1, $limit );
4623 146509         225024 $node->[$ri] = $self->_build_tree( $node->[$ri], $depth + 1, $limit );
4624              
4625 146509         347658 return $node;
4626             } ## end sub _build_tree
4627              
4628             # Axis-parallel cut: random varying feature, random threshold in its range.
4629             # Returns [_NODE_AXIS, attr, split, \@left_pts, \@right_pts].
4630             # _build_tree overwrites slots 3 and 4 with the recursed subtrees.
4631             sub _axis_split {
4632 123727     123727   182997 my ( $X, $varying, $lo, $hi, $nan ) = @_;
4633              
4634 123727         188098 my $attr = $varying->[ int( rand( scalar @$varying ) ) ];
4635 123727         133962 my $split;
4636 123727         132128 if (_NV_IS_DOUBLE) {
4637 123727         174676 $split = $lo->[$attr] + rand() * ( $hi->[$attr] - $lo->[$attr] );
4638             } else {
4639             # Same value, but rounded to double after each of the three ops
4640             # exactly as the C builder computes it -- see _NV_IS_DOUBLE.
4641             $split = _to_double( $hi->[$attr] - $lo->[$attr] );
4642             $split = _to_double( rand() * $split );
4643             $split = _to_double( $lo->[$attr] + $split );
4644             }
4645              
4646             # A point missing the split feature (nan mode only) routes to the right
4647             # child -- the same side NaN reaches in the C scorer, where (NaN < split)
4648             # is false. Under die/zero/impute every cell is defined, so the
4649             # "defined($v)" guard is dead weight there and skipped entirely.
4650 123727         145999 my ( @left, @right );
4651 123727 100       157889 if ($nan) {
4652 15096         18813 for my $row (@$X) {
4653 239367         258630 my $v = $row->[$attr];
4654 239367 100 100     430151 if ( defined($v) && $v < $split ) { push @left, $row }
  111298         146865  
4655 128069         177019 else { push @right, $row }
4656             }
4657             } else {
4658 108631         135548 for my $row (@$X) {
4659 2196007 100       2751621 if ( $row->[$attr] < $split ) { push @left, $row }
  1096061         1397371  
4660 1099946         1410487 else { push @right, $row }
4661             }
4662             }
4663 123727         306528 return [ _NODE_AXIS, $attr, $split, \@left, \@right ];
4664             } ## end sub _axis_split
4665              
4666             # Oblique cut (Extended Isolation Forest): a random hyperplane. We activate
4667             # (extension_level + 1) of the varying features, give each a Gaussian
4668             # coefficient, and place the plane through a random point in the bounding box.
4669             # A point goes left when coef . x <= b, where b = coef . p.
4670             # Returns [_NODE_OBLIQUE, \@idx, \@coef, $b, \@left_pts, \@right_pts].
4671             # _build_tree overwrites slots 4 and 5 with the recursed subtrees.
4672             sub _oblique_split {
4673 22782     22782   36139 my ( $self, $X, $varying, $lo, $hi, $nan ) = @_;
4674              
4675 22782         30708 my $active = $self->{extension_level_used} + 1;
4676 22782 100       36632 $active = scalar @$varying if $active > scalar @$varying;
4677              
4678             # Pick which varying features take part (partial shuffle of their indices).
4679 22782         31660 my @pool = @$varying;
4680 22782         32497 for my $i ( 0 .. $active - 1 ) {
4681 43954         62876 my $j = $i + int( rand( scalar(@pool) - $i ) );
4682 43954         68342 @pool[ $i, $j ] = @pool[ $j, $i ];
4683             }
4684 22782         39241 my @idx = @pool[ 0 .. $active - 1 ];
4685              
4686 22782         29028 my ( @coef, $b );
4687 22782         33216 $b = 0.0;
4688 22782         28069 for my $f (@idx) {
4689 43954         56462 my $c = _randn();
4690 43954         48998 if (_NV_IS_DOUBLE) {
4691 43954         60326 my $p = $lo->[$f] + rand() * ( $hi->[$f] - $lo->[$f] ); # point in the box
4692 43954         56535 push @coef, $c;
4693 43954         57809 $b += $c * $p;
4694             } else {
4695             # Round each op to double in the same order as the C builder's
4696             # p = lo + rand() * (hi - lo); b += c * p;
4697             # -- see _NV_IS_DOUBLE.
4698             my $p = _to_double( rand() * _to_double( $hi->[$f] - $lo->[$f] ) );
4699             $p = _to_double( $lo->[$f] + $p );
4700             push @coef, $c;
4701             $b = _to_double( $b + _to_double( $c * $p ) );
4702             }
4703             } ## end for my $f (@idx)
4704              
4705             # A point missing any feature on the hyperplane (nan mode only) routes
4706             # to the right child: in the C scorer the dot product becomes NaN and
4707             # (NaN <= b) is false, so this keeps fit and score consistent. Under
4708             # die/zero/impute every cell is defined, so the per-feature "defined"
4709             # check and early-exit are dead weight there and skipped entirely.
4710 22782         27311 my ( @left, @right );
4711 22782 100       30678 if ($nan) {
4712 6947         9319 for my $row (@$X) {
4713 139686         149776 my $dot = 0.0;
4714 139686         146957 my $missing = 0;
4715 139686         186345 for ( 0 .. $#idx ) {
4716 262282         298695 my $v = $row->[ $idx[$_] ];
4717 262282 100       336649 if ( !defined $v ) { $missing = 1; last }
  26240         27938  
  26240         28766  
4718 236042         287969 $dot += $coef[$_] * $v;
4719             }
4720 139686 100 100     255134 if ( !$missing && $dot <= $b ) { push @left, $row }
  57761         80930  
4721 81925         113331 else { push @right, $row }
4722             } ## end for my $row (@$X)
4723             } else {
4724 15835         20952 for my $row (@$X) {
4725 400353         427272 my $dot = 0.0;
4726 400353         730968 $dot += $coef[$_] * $row->[ $idx[$_] ] for 0 .. $#idx;
4727 400353 100       509815 if ( $dot <= $b ) { push @left, $row }
  197051         255444  
4728 203302         259794 else { push @right, $row }
4729             }
4730             }
4731 22782         70659 return [ _NODE_OBLIQUE, \@idx, \@coef, $b, \@left, \@right ];
4732             } ## end sub _oblique_split
4733              
4734             #-------------------------------------------------------------------------------
4735             # Path length of a single point in a single tree: edges traversed until a leaf,
4736             # plus c(leaf size) when the leaf still holds several points.
4737             #
4738             # Node layout (arrayref, slot 0 = type):
4739             # _NODE_LEAF [0, size]
4740             # _NODE_AXIS [1, attr, split, left, right]
4741             # _NODE_OBLIQUE [2, \@idx, \@coef, b, left, right]
4742             #
4743             # The type tag is also used as a loop sentinel: 0 (_NODE_LEAF) is falsy.
4744             # No $self argument -- the node type encodes everything needed.
4745             #-------------------------------------------------------------------------------
4746             # The optional $nan flag selects the nan-strategy routing: a point missing
4747             # the split feature goes to the right child (matching the C scorer, where
4748             # the NaN comparison is false). Without it, undef is coerced to 0 -- the
4749             # behaviour the die/zero/impute strategies rely on (their data is dense by
4750             # the time it reaches here, so the "// 0" is normally a no-op).
4751             sub _path_length {
4752 428723     428723   569852 my ( $x, $node, $depth, $nan ) = @_;
4753 428723         585252 while ( $node->[0] ) { # false only for leaf (type 0)
4754 2987602 100       3628154 if ( $node->[0] == _NODE_AXIS ) { # [1, attr, split, left, right]
4755 2757920 100       3230328 if ($nan) {
4756 4852         5445 my $v = $x->[ $node->[1] ];
4757 4852 100 100     9465 $node = ( defined($v) && $v < $node->[2] ) ? $node->[3] : $node->[4];
4758             } else {
4759 2753068 100 100     4550878 $node = ( $x->[ $node->[1] ] // 0 ) < $node->[2] ? $node->[3] : $node->[4];
4760             }
4761             } else { # [2, \@idx, \@coef, b, left, right]
4762 229682         300758 my ( $idx, $coef, $b ) = ( $node->[1], $node->[2], $node->[3] );
4763 229682 100       269310 if ($nan) {
4764 3034         3232 my $dot = 0.0;
4765 3034         3182 my $missing = 0;
4766 3034         4008 for ( 0 .. $#$idx ) {
4767 4727         5934 my $v = $x->[ $idx->[$_] ];
4768 4727 100       6105 if ( !defined $v ) { $missing = 1; last }
  1920         1996  
  1920         2171  
4769 2807         3754 $dot += $coef->[$_] * $v;
4770             }
4771 3034 100 100     5736 $node = ( !$missing && $dot <= $b ) ? $node->[4] : $node->[5];
4772             } else {
4773 226648         230373 my $dot = 0.0;
4774 226648   100     533473 $dot += $coef->[$_] * ( $x->[ $idx->[$_] ] // 0 ) for 0 .. $#$idx;
4775 226648 100       314407 $node = $dot <= $b ? $node->[4] : $node->[5];
4776             }
4777             } ## end else [ if ( $node->[0] == _NODE_AXIS ) ]
4778 2987602         4077577 $depth++;
4779             } ## end while ( $node->[0] )
4780 428723         551073 return $depth + _c( $node->[1] ); # leaf size at slot 1
4781             } ## end sub _path_length
4782              
4783             # Recursively convert a version-0 hash-based tree node to the version-1
4784             # array format. Called by from_json when loading an old saved model.
4785             sub _hash_node_to_array {
4786 0     0   0 my ($node) = @_;
4787 0 0       0 if ( $node->{leaf} ) {
    0          
4788 0         0 return [ _NODE_LEAF, $node->{size} ];
4789             } elsif ( exists $node->{attr} ) {
4790             return [
4791             _NODE_AXIS, $node->{attr},
4792             $node->{split}, _hash_node_to_array( $node->{left} ),
4793 0         0 _hash_node_to_array( $node->{right} ),
4794             ];
4795             } else {
4796             return [
4797             _NODE_OBLIQUE, $node->{idx}, $node->{coef}, $node->{b},
4798             _hash_node_to_array( $node->{left} ),
4799 0         0 _hash_node_to_array( $node->{right} ),
4800             ];
4801             }
4802             } ## end sub _hash_node_to_array
4803              
4804             # ---------------------------------------------------------------------------
4805             # _pack_tree($root) -- flatten one tree into three packed buffers.
4806             #
4807             # Returns ($nodes_packed, $idx_packed, $val_packed) where:
4808             # nodes_packed: 6 doubles per node (see score_all_xs comment above)
4809             # idx_packed: int32 feature indices for every oblique-node coefficient
4810             # val_packed: double values matching idx_packed one-for-one
4811             #
4812             # Storing idx and val in separate buffers (SoA) instead of interleaved
4813             # doubles lets the oblique dot product's SIMD inner loop run over a
4814             # contiguous val[] stream without a per-iteration (int) cast, and
4815             # halves the index bandwidth (int32 vs double). The same `coff`
4816             # offset addresses paired entries in both buffers.
4817             #
4818             # Nodes are numbered in DFS pre-order: the root is always index 0 and
4819             # children always get indices larger than their parent's.
4820             # ---------------------------------------------------------------------------
4821             sub _pack_tree {
4822 6817     6817   10422 my ( $root, $n_features ) = @_;
4823 6817         12603 my ( @node_data, @coef_idx, @coef_val );
4824              
4825 6817         0 my $assign;
4826             $assign = sub {
4827 604539     604539   734767 my ($node) = @_;
4828 604539         664544 my $my_idx = scalar @node_data;
4829 604539         729970 push @node_data, undef; # reserve slot; filled in after children
4830              
4831 604539 100       959326 if ( $node->[0] == _NODE_LEAF ) {
    100          
4832              
4833             # Slot 2 carries c(size) precomputed, so the C scoring loop
4834             # adds it straight to the depth instead of paying a log()
4835             # per point per tree at every leaf hit. _c is the same
4836             # function the pure-Perl scorer uses, so both backends keep
4837             # producing bit-identical path lengths.
4838 305678         412928 $node_data[$my_idx] = [ 0.0, $node->[1] + 0.0, _c( $node->[1] ), 0.0, 0.0, 0.0 ];
4839             } elsif ( $node->[0] == _NODE_AXIS ) {
4840 269152         457547 my $li = $assign->( $node->[3] );
4841 269152         351391 my $ri = $assign->( $node->[4] );
4842 269152         506007 $node_data[$my_idx] = [
4843             1.0,
4844             $node->[1] + 0.0, # attr
4845             $node->[2] + 0.0, # split
4846             $li + 0.0,
4847             $ri + 0.0,
4848             0.0,
4849             ];
4850             } else { # _NODE_OBLIQUE
4851 29709         44790 my ( $idx_arr, $coef_arr, $b ) = ( $node->[1], $node->[2], $node->[3] );
4852 29709         34062 my $coef_off = scalar @coef_idx;
4853 29709         36905 my $num = scalar @$idx_arr;
4854              
4855             # Dense-pack opportunity: when this oblique split uses
4856             # every feature (extension_level == n_features - 1 and
4857             # all features vary), pack the coefficients in feature
4858             # order so val[k] is the coefficient for feature k. The
4859             # C scoring path then detects `nf == n_feats` and switches
4860             # to a no-gather inner loop (dot += val[k] * xi[k]) that
4861             # auto-vectorizes cleanly with FMA.
4862 29709 100 66     60017 if ( defined $n_features && $num == $n_features ) {
4863 25903         29261 my %coef_for;
4864 25903         57664 @coef_for{@$idx_arr} = @$coef_arr;
4865 25903         37594 for my $k ( 0 .. $n_features - 1 ) {
4866 60921         83104 push @coef_idx, $k;
4867 60921         105146 push @coef_val, $coef_for{$k} + 0.0;
4868             }
4869             } else {
4870 3806         5333 for my $i ( 0 .. $num - 1 ) {
4871 3811         5777 push @coef_idx, int( $idx_arr->[$i] );
4872 3811         5823 push @coef_val, $coef_arr->[$i] + 0.0;
4873             }
4874             }
4875              
4876 29709         54345 my $li = $assign->( $node->[4] );
4877 29709         39720 my $ri = $assign->( $node->[5] );
4878 29709         59862 $node_data[$my_idx] = [ 2.0, $coef_off + 0.0, $num + 0.0, $li + 0.0, $ri + 0.0, $b + 0.0, ];
4879             } ## end else [ if ( $node->[0] == _NODE_LEAF ) ]
4880 604539         758748 return $my_idx;
4881 6817         36607 }; ## end $assign = sub
4882 6817         14080 $assign->($root);
4883              
4884 6817         13525 my $nodes_packed = pack( 'd*', map { @$_ } @node_data );
  604539         1037664  
4885 6817 100       78460 my $idx_packed = @coef_idx ? pack( 'l*', @coef_idx ) : pack('l*');
4886 6817 100       12517 my $val_packed = @coef_val ? pack( 'd*', @coef_val ) : pack('d*');
4887 6817         20287 return ( $nodes_packed, $idx_packed, $val_packed );
4888             } ## end sub _pack_tree
4889              
4890             # Build packed C-ready representations for all trees and store them in
4891             # $self->{_c_nodes}, $self->{_c_coef_idx}, $self->{_c_coef_val}.
4892             # Called after fit() and from_json() when _use_c is true. n_features is
4893             # threaded through so _pack_tree can spot the dense-pack opportunity.
4894             sub _rebuild_c_trees {
4895 145     145   439 my ($self) = @_;
4896 145         313 my ( @c_nodes, @c_coef_idx, @c_coef_val );
4897 145         274 for my $tree ( @{ $self->{trees} } ) {
  145         499  
4898 6817         14242 my ( $np, $ip, $vp ) = _pack_tree( $tree, $self->{n_features} );
4899 6817         12523 push @c_nodes, $np;
4900 6817         9993 push @c_coef_idx, $ip;
4901 6817         14590 push @c_coef_val, $vp;
4902             }
4903 145         640 $self->{_c_nodes} = \@c_nodes;
4904 145         468 $self->{_c_coef_idx} = \@c_coef_idx;
4905 145         642 $self->{_c_coef_val} = \@c_coef_val;
4906             } ## end sub _rebuild_c_trees
4907              
4908             sub _check_fitted {
4909 1216     1216   2430 my ($self) = @_;
4910             croak "model is not fitted yet; call fit() first"
4911 1216 100 66     4778 unless ref $self->{trees} eq 'ARRAY' && @{ $self->{trees} };
  1216         8657  
4912             }
4913              
4914             # ---------------------------------------------------------------------------
4915             # Optional Algorithm::ToNumberMunger integration -- see the MUNGERS POD
4916             # section. Both helpers are plain functions (not methods) so the Online
4917             # class's delegating methods can hand them their own $self: the plan and
4918             # spec live in the same hash slots on either class.
4919             # ---------------------------------------------------------------------------
4920              
4921             # Validate a feature_descriptions hash against the feature names: every
4922             # described feature must exist (a description for one that does not is
4923             # either a typo or a stale leftover from a schema change) and every
4924             # description must be a plain string. Partial coverage is fine. A plain
4925             # function, like the munger helpers, so both classes and the prototype
4926             # validator can call it.
4927             sub _validate_feature_descriptions {
4928 35     35   84 my ( $tags, $fd ) = @_;
4929 35 50       103 croak "feature_descriptions must be a hashref of 'feature name => description'"
4930             unless ref $fd eq 'HASH';
4931 35 100 66     416 croak "feature_descriptions requires feature_names to validate against"
4932             unless ref $tags eq 'ARRAY' && @$tags;
4933 34         79 my %known = map { $_ => 1 } @$tags;
  72         223  
4934 34         107 for my $k ( sort keys %$fd ) {
4935             croak "feature_descriptions describes '$k', which is not in feature_names"
4936 34 100       651 unless $known{$k};
4937             croak "feature_descriptions entry for '$k' must be a plain string"
4938 31 100       278 if ref $fd->{$k};
4939             }
4940 30         86 return 1;
4941             } ## end sub _validate_feature_descriptions
4942              
4943             # Compile a munger spec against the model's feature names. Requires
4944             # Algorithm::ToNumberMunger on demand -- it is an optional dependency --
4945             # and lets its compile() croak on any spec problem.
4946             sub _compile_mungers {
4947 15     15   35 my ( $tags, $mungers ) = @_;
4948 15 50 33     87 croak "this model has mungers but no feature_names to compile them against"
4949             unless ref $tags eq 'ARRAY' && @$tags;
4950 15         45 local $@;
4951 15 50       48 eval { require Algorithm::ToNumberMunger; 1 }
  15         4565  
  15         98017  
4952             or croak "this model has mungers configured but Algorithm::ToNumberMunger "
4953             . "could not be loaded; install it to use tagged data with this model: $@";
4954 15         130 return Algorithm::ToNumberMunger->compile(
4955             tags => $tags,
4956             mungers => $mungers,
4957             );
4958             } ## end sub _compile_mungers
4959              
4960             # The compiled plan for this model, or undef when no mungers are
4961             # configured. Compiled lazily (memoised in _munger_plan) so from_json
4962             # does not need Algorithm::ToNumberMunger installed unless tagged data
4963             # is actually used; new() populates the slot eagerly instead, surfacing
4964             # spec errors at construction.
4965             sub _plan {
4966 1014     1014   1278 my ($self) = @_;
4967 1014 100       1718 return undef unless $self->{mungers};
4968 952   66     1339 $self->{_munger_plan} //= _compile_mungers( $self->{feature_names}, $self->{mungers} );
4969 951         2109 return $self->{_munger_plan};
4970             }
4971              
4972             # Memoised "does this perl have a real fork()?". False on Windows
4973             # without Cygwin; true on every Unix-like platform.
4974             {
4975             my $cached;
4976              
4977             sub _fork_supported {
4978 8 100   8   41 return $cached if defined $cached;
4979 2         23 require Config;
4980             $cached
4981 2 50 50     61 = ( ( $Config::Config{d_fork} || '' ) eq 'define' ) ? 1 : 0;
4982 2         10 return $cached;
4983             }
4984             }
4985              
4986             #-------------------------------------------------------------------------------
4987             # Fork-based parallel tree builder. Used by fit() when parallel_fit > 1
4988             # and the platform has a real fork(). Divides n_trees evenly among
4989             # workers; each child seeds its own RNG ($seed + worker_id * 1009 so
4990             # fixed-worker-count runs are reproducible), builds its share (via the
4991             # C builder when _use_c is on, same as the non-parallel path), and
4992             # returns the trees to the parent via Storable on a one-shot pipe.
4993             #
4994             # The trees that come back differ from a serial fit with the same seed
4995             # because the RNG draws happen in a different order -- this is documented
4996             # as part of the parallel_fit contract.
4997             #-------------------------------------------------------------------------------
4998             sub _fit_trees_parallel {
4999 8     8   25 my ( $self, $data, $psi, $limit, $workers ) = @_;
5000 8         68 require Storable;
5001 8         28 require POSIX;
5002              
5003 8         27 my $n_trees = $self->{n_trees};
5004 8 100       44 $workers = $n_trees if $workers > $n_trees;
5005              
5006             # Divide n_trees as evenly as possible across workers.
5007 8         24 my @shares;
5008             {
5009 8         15 my $base = int( $n_trees / $workers );
  8         15  
5010 8         19 my $extras = $n_trees - $base * $workers;
5011 8         20 for my $w ( 0 .. $workers - 1 ) {
5012 26 100       61 push @shares, $base + ( $w < $extras ? 1 : 0 );
5013             }
5014             }
5015              
5016 8         13 my @procs; # { pid, rh, share }
5017 8         19 for my $w ( 0 .. $workers - 1 ) {
5018 26         170 my $share = $shares[$w];
5019 26 50       130 next unless $share > 0;
5020              
5021 26 50       1988 pipe( my $rh, my $wh ) or croak "pipe failed: $!";
5022 26         40826 my $pid = fork();
5023 26 50       1256 croak "fork failed: $!" unless defined $pid;
5024              
5025 26 50       913 if ( $pid == 0 ) {
5026             # child
5027 0         0 close $rh;
5028 0         0 binmode $wh;
5029 0 0       0 if ( defined $self->{seed} ) {
5030 0         0 srand( $self->{seed} + $w * 1009 );
5031             }
5032             # Deliberately never _build_forest_openmp here, even when
5033             # use_openmp_fit is on: if this process (or the parent that
5034             # fork()ed us) already ran any OpenMP region before this
5035             # fork -- including plain score_samples()/predict() with
5036             # the default use_openmp -- libgomp's thread pool exists
5037             # but its worker threads didn't survive the fork. A child
5038             # starting its own #pragma omp parallel region then tries
5039             # to reuse that now-invalid pool and hangs. This is a
5040             # general fork()+libgomp limitation, not fixable from here,
5041             # so forked workers always use the single-threaded C
5042             # builder (or pure Perl) instead. See t/03-fit-determinism.t
5043             # and the NATIVE ACCELERATION docs for the observed hang and
5044             # why parallel_fit + use_openmp_fit isn't composed for real.
5045 0         0 my $trees;
5046 0 0       0 if ( $self->{_use_c} ) {
5047 0         0 $trees = $self->_build_forest_c( $data, $psi, $limit, $share );
5048             } else {
5049 0         0 my @t;
5050 0         0 for ( 1 .. $share ) {
5051 0         0 my $sample = _subsample( $data, $psi );
5052 0         0 push @t, $self->_build_tree( $sample, 0, $limit );
5053             }
5054 0         0 $trees = \@t;
5055             }
5056 0         0 print $wh Storable::freeze($trees);
5057 0         0 close $wh;
5058             # _exit so we don't run parent END/DESTROY in the child.
5059 0         0 POSIX::_exit(0);
5060             } ## end if ( $pid == 0 )
5061              
5062 26         1743 close $wh;
5063 26         563 binmode $rh;
5064 26         5312 push @procs, { pid => $pid, rh => $rh, share => $share };
5065             } ## end for my $w ( 0 .. $workers - 1 )
5066              
5067             # Collect from each pipe in worker order so the canonical tree
5068             # ordering is deterministic (worker 0's trees first, then 1's, ...).
5069 8         174 my @all_trees;
5070 8         106 for my $p (@procs) {
5071 26         115 my $buf;
5072             {
5073 26         85 local $/;
  26         794  
5074 26         37893 $buf = readline( $p->{rh} );
5075             }
5076 26         393 close $p->{rh};
5077 26         29000 waitpid( $p->{pid}, 0 );
5078 26         356 my $exit = $? >> 8;
5079 26 50       127 croak "parallel_fit worker $p->{pid} exited with status $exit"
5080             if $exit != 0;
5081 26         106 my $trees = eval { Storable::thaw($buf) };
  26         419  
5082 26 50 33     26372 croak "parallel_fit worker $p->{pid} returned unparseable trees: $@"
5083             if $@ || ref $trees ne 'ARRAY';
5084 26         209 push @all_trees, @$trees;
5085             } ## end for my $p (@procs)
5086              
5087 8         316 return \@all_trees;
5088             } ## end sub _fit_trees_parallel
5089              
5090             #-------------------------------------------------------------------------------
5091             # C-accelerated fit(): builds $n_trees trees against $data (a subset or
5092             # the full training set) via build_forest_xs, which does its own
5093             # per-tree subsampling internally. Random draws inside the C builder
5094             # go through Drand01() -- the same generator Perl's rand() uses -- in
5095             # the same call order _subsample/_build_tree used, so the returned
5096             # trees are bit-identical to what the pure-Perl path would build from
5097             # the same RNG state. That's what lets fit() switch backends on the
5098             # existing `use_c` knob instead of a new one.
5099             #-------------------------------------------------------------------------------
5100             sub _build_forest_c {
5101 92     92   300 my ( $self, $data, $psi, $limit, $n_trees ) = @_;
5102 92         192 my $n = scalar @$data;
5103 92         217 my $nf = $self->{n_features};
5104 92         11099 my $x_packed = "\0" x ( $n * $nf * 8 );
5105 92         412 my ( $mode, $fill ) = $self->_pack_args;
5106 92         2157 pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
5107              
5108 92 100       302 my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
5109 92   100     442 my $ext_level = $self->{extension_level_used} // 0;
5110              
5111 92         184 my $trees = [];
5112 92         280127 build_forest_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit, $mode_flag, $ext_level, $trees );
5113 92         710 return $trees;
5114             } ## end sub _build_forest_c
5115              
5116             #-------------------------------------------------------------------------------
5117             # OpenMP-parallel fit(): builds $n_trees trees across OpenMP threads (one
5118             # tree per thread) via build_forest_openmp_xs. Unlike _build_forest_c,
5119             # random draws come from a thread-private PRNG seeded per tree index
5120             # rather than Drand01() -- Perl's RNG state can't be shared safely
5121             # across OpenMP threads -- so the resulting trees are NOT bit-identical
5122             # to the use_c (serial) or pure-Perl paths for the same seed, though a
5123             # fixed seed + n_trees still reproduce the same trees regardless of
5124             # OMP_NUM_THREADS. This is why it's gated by the separate, opt-in
5125             # use_openmp_fit knob rather than reusing use_c/use_openmp.
5126             #
5127             # Only called from fit()'s non-forked branch. _fit_trees_parallel's
5128             # workers never call this, even when use_openmp_fit is on: a forked
5129             # child starting its own OpenMP region after the parent process has
5130             # used OpenMP for anything (this includes plain score_samples()) can
5131             # hang -- see the comment above that branch for the fork()+libgomp
5132             # hazard this avoids.
5133             #
5134             # build_forest_openmp_xs hands back three arrayrefs of per-tree packed
5135             # buffers (the same SoA layout _pack_tree produces) instead of Perl tree
5136             # structures -- that's how it avoids any Perl API call inside its
5137             # parallel region. _unpack_forest converts them back into the ordinary
5138             # nested-arrayref tree shape so to_json/from_json/_rebuild_c_trees don't
5139             # need to know this path exists.
5140             #-------------------------------------------------------------------------------
5141             sub _build_forest_openmp {
5142 7     7   23 my ( $self, $data, $psi, $limit, $n_trees ) = @_;
5143 7         14 my $n = scalar @$data;
5144 7         16 my $nf = $self->{n_features};
5145 7         295 my $x_packed = "\0" x ( $n * $nf * 8 );
5146 7         33 my ( $mode, $fill ) = $self->_pack_args;
5147 7         142 pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
5148              
5149 7 100       24 my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
5150 7   100     27 my $ext_level = $self->{extension_level_used} // 0;
5151              
5152 7         13 my ( @nodes, @idx, @val );
5153 7         27861 build_forest_openmp_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit,
5154             $mode_flag, $ext_level, \@nodes, \@idx, \@val, 1 );
5155              
5156 7         64 return _unpack_forest( \@nodes, \@idx, \@val );
5157             } ## end sub _build_forest_openmp
5158              
5159             # Inverse of _pack_tree's SoA layout: given one tree's packed node
5160             # buffer plus the shared idx/val coefficient buffers, reconstructs the
5161             # ordinary nested-arrayref tree structure _build_tree/_build_node_c
5162             # produce. li/ri fields hold the child's absolute node index, so this
5163             # just follows them recursively from whatever index the caller says the
5164             # root lives at. NOTE: _pack_tree numbers nodes DFS pre-order (root at
5165             # 0), but build_forest_openmp_xs appends nodes post-order (children
5166             # before parent), putting the root LAST -- the caller must pass the
5167             # right root index for the buffer's origin.
5168             sub _unpack_node {
5169 12844     12844   18679 my ( $nodes, $idx, $val, $node_i ) = @_;
5170 12844         15390 my $off = $node_i * 6;
5171 12844         15812 my $type = $nodes->[$off];
5172              
5173 12844 100       19757 if ( $type == 0 ) {
    100          
5174 6582         24194 return [ _NODE_LEAF, int( $nodes->[ $off + 1 ] ) ];
5175             } elsif ( $type == 1 ) {
5176             my ( $attr, $split, $li, $ri )
5177 1604         2061 = @{$nodes}[ $off + 1 .. $off + 4 ];
  1604         2346  
5178             return [
5179 1604         2608 _NODE_AXIS, int($attr), $split,
5180             _unpack_node( $nodes, $idx, $val, int($li) ),
5181             _unpack_node( $nodes, $idx, $val, int($ri) ),
5182             ];
5183             } else {
5184 4658         10063 my ( $coff, $num, $li, $ri, $b ) = @{$nodes}[ $off + 1 .. $off + 5 ];
  4658         8004  
5185 4658         6619 $coff = int($coff);
5186 4658         5740 $num = int($num);
5187             return [
5188             _NODE_OBLIQUE,
5189 4658         8979 [ @{$idx}[ $coff .. $coff + $num - 1 ] ],
5190 4658         6640 [ @{$val}[ $coff .. $coff + $num - 1 ] ],
  4658         10227  
5191             $b,
5192             _unpack_node( $nodes, $idx, $val, int($li) ),
5193             _unpack_node( $nodes, $idx, $val, int($ri) ),
5194             ];
5195             } ## end else [ if ( $type == 0 ) ]
5196             } ## end sub _unpack_node
5197              
5198             # Unpacks every tree in the three per-tree packed-buffer arrayrefs
5199             # build_forest_openmp_xs returns into the ordinary nested tree shape.
5200             # The C builder pushes nodes post-order (a node is recorded after both
5201             # of its children), so each tree's root is the LAST node record, not
5202             # index 0 as in _pack_tree's pre-order layout.
5203             sub _unpack_forest {
5204 7     7   28 my ( $nodes_list, $idx_list, $val_list ) = @_;
5205 7         17 my @trees;
5206 7         40 for my $i ( 0 .. $#$nodes_list ) {
5207 320         2793 my @nodes = unpack( 'd*', $nodes_list->[$i] );
5208 320         1303 my @idx = unpack( 'l*', $idx_list->[$i] );
5209 320         1155 my @val = unpack( 'd*', $val_list->[$i] );
5210 320         663 my $root = @nodes / 6 - 1;
5211 320         665 push @trees, _unpack_node( \@nodes, \@idx, \@val, $root );
5212             }
5213 7         62 return \@trees;
5214             } ## end sub _unpack_forest
5215              
5216             #-------------------------------------------------------------------------------
5217             # Packed input wrapper. pack_data() returns one of these so callers can
5218             # score the same dataset many times without re-walking the AV/AV refs on
5219             # every call -- a meaningful win at high feature counts where
5220             # pack_input_xs is a non-trivial slice of total scoring time.
5221             #
5222             # It's a minimal blessed hashref: { packed, n_pts, n_feats }. The C
5223             # scoring functions only need the packed bytes + dimensions.
5224             #-------------------------------------------------------------------------------
5225             sub pack_data {
5226 7     7 1 1987 my ( $self, $data ) = @_;
5227 7         37 $self->_check_fitted;
5228             croak "pack_data requires the Inline::C backend; install Inline::C"
5229 6 100       245 unless $self->{_use_c};
5230 5 100       246 croak "pack_data() expects an arrayref of samples"
5231             unless ref $data eq 'ARRAY';
5232 3         5 my $n_pts = scalar @$data;
5233 3         8 my $nf = $self->{n_features};
5234 3         24 my $x_packed = "\0" x ( $n_pts * $nf * 8 );
5235 3         16 my ( $mode, $fill ) = $self->_pack_args;
5236 3         46 pack_input_xs( $data, $x_packed, $n_pts, $nf, $mode, $fill );
5237 3         46 return bless {
5238             packed => $x_packed,
5239             n_pts => $n_pts,
5240             n_feats => $nf,
5241             },
5242             'Algorithm::Classifier::IsolationForest::PackedData';
5243             } ## end sub pack_data
5244              
5245             # Internal helper: given $data that may be a raw arrayref OR a PackedData
5246             # instance, return the (n_pts, n_feats, x_packed) triple ready for
5247             # score_all_xs. Called from every scoring fast path.
5248             sub _resolve_input {
5249 1081     1081   4826 my ( $self, $data ) = @_;
5250 1081 100       2833 if ( ref $data eq 'Algorithm::Classifier::IsolationForest::PackedData' ) {
5251             croak "PackedData has $data->{n_feats} features but model expects " . $self->{n_features}
5252 344 100       1102 unless $data->{n_feats} == $self->{n_features};
5253 343         1150 return ( $data->{n_pts}, $data->{n_feats}, $data->{packed} );
5254             }
5255 737         1344 my $n_pts = scalar @$data;
5256 737         1324 my $nf = $self->{n_features};
5257 737         2420 my $x_packed = "\0" x ( $n_pts * $nf * 8 );
5258 737         2061 my ( $mode, $fill ) = $self->_pack_args;
5259 737         5188 pack_input_xs( $data, $x_packed, $n_pts, $nf, $mode, $fill );
5260 737         1994 return ( $n_pts, $nf, $x_packed );
5261             } ## end sub _resolve_input
5262              
5263             # Helper used by the pure-Perl fallback paths: convert either form back
5264             # to an arrayref-of-arrayrefs. Slow on PackedData -- the whole point of
5265             # packing is to keep things in C -- but lets the fallback path be
5266             # uniformly arrayref-driven.
5267             sub _to_arrayref {
5268 99     99   190 my ( $self, $data ) = @_;
5269 99 50       400 return $data if ref $data eq 'ARRAY';
5270 0 0       0 if ( ref $data eq 'Algorithm::Classifier::IsolationForest::PackedData' ) {
5271 0         0 my $n_pts = $data->{n_pts};
5272 0         0 my $nf = $data->{n_feats};
5273 0         0 my @doubles = unpack( 'd*', $data->{packed} );
5274 0         0 my @rows;
5275 0         0 for my $i ( 0 .. $n_pts - 1 ) {
5276 0         0 push @rows, [ @doubles[ $i * $nf .. ( $i + 1 ) * $nf - 1 ] ];
5277             }
5278 0         0 return \@rows;
5279             } ## end if ( ref $data eq 'Algorithm::Classifier::IsolationForest::PackedData')
5280 0   0     0 croak "expected arrayref or PackedData, got " . ( ref($data) || 'scalar' );
5281             } ## end sub _to_arrayref
5282              
5283             # ---------------------------------------------------------------------------
5284             # Missing-value handling.
5285             #
5286             # The `missing` strategy chosen at new() decides how undef feature cells are
5287             # treated. Scoring always tolerates undef; the strategy governs fit() and
5288             # how undef is represented for the scorer:
5289             #
5290             # die -- croak from fit() if the training data holds any undef cell.
5291             # Scoring still maps undef -> 0 (the long-standing behaviour).
5292             # zero -- undef counts as the value 0, at fit and score time.
5293             # impute -- undef is replaced by a learned per-feature mean/median; the
5294             # fill vector is stored on the model and reused at score time.
5295             # nan -- ranges are built over present values only and a point missing
5296             # the split feature is routed to the right child, consistently
5297             # at fit (Perl) and score (C packs NaN; `<`/`<=` send it right).
5298             # ---------------------------------------------------------------------------
5299              
5300             # Returns the training data to actually build trees on, after applying the
5301             # missing-value strategy. May croak (die), return a dense filled copy
5302             # (zero/impute), or pass $data through unchanged (nan).
5303             sub _prepare_fit_data {
5304 162     162   392 my ( $self, $data ) = @_;
5305 162         373 my $m = $self->{missing};
5306 162         288 my $nf = $self->{n_features};
5307              
5308 162 100       432 if ( $m eq 'die' ) {
5309 136         453 for my $i ( 0 .. $#$data ) {
5310 17970         21477 my $row = $data->[$i];
5311 17970         22262 for my $f ( 0 .. $nf - 1 ) {
5312 50079 100       75039 next if defined $row->[$f];
5313 2         346 croak "fit(): undef feature value at sample $i, column $f; "
5314             . "construct with missing => 'zero', 'impute', or 'nan' "
5315             . "to train on data with missing values";
5316             }
5317             }
5318 134         462 return $data;
5319             } ## end if ( $m eq 'die' )
5320              
5321             # nan: leave undef in place -- _build_tree / the split routers handle it.
5322 26 100       86 return $data if $m eq 'nan';
5323              
5324             # zero / impute: undef has to become a real number somewhere before a
5325             # split can look at it. The fill vector is computed either way (it's
5326             # needed for persistence and for scoring later), but densifying $data
5327             # into a second, fully separate Perl array here is only necessary for
5328             # the pure-Perl tree builder (_build_tree assumes every cell is
5329             # defined once missing != 'nan' -- see its lo/hi scan). The C
5330             # tree-building path -- _build_forest_c/_build_forest_openmp, and
5331             # every parallel_fit worker, all of which go through pack_input_xs --
5332             # already fills undef cells itself from this same fill vector, so
5333             # skip the redundant whole-dataset copy when that's the path fit()
5334             # will actually take. Scoring the training set for a learned
5335             # contamination threshold (below, in fit()) is unaffected: it always
5336             # runs through the pure-Perl scorer regardless of use_c (fit() drops
5337             # any previous fit's packed buffers before that scoring, and
5338             # _rebuild_c_trees runs after), and that path already tolerates raw
5339             # undef cells
5340             # for both zero (_path_length's "// 0") and impute (_prepare_perl_input
5341             # densifies on demand from missing_fill).
5342 18 100       79 my $fill
5343             = $m eq 'impute'
5344             ? $self->_compute_impute_fill($data)
5345             : [ (0) x $nf ];
5346 14 100       47 $self->{missing_fill} = $fill if $m eq 'impute';
5347 14         33 delete $self->{_fill_packed};
5348              
5349 14 100       70 return $data if $self->{_use_c};
5350 7         39 return _densify( $data, $fill );
5351             } ## end sub _prepare_fit_data
5352              
5353             # Per-feature fill value (mean or median of the present values) for impute
5354             # mode. Croaks if a feature has no present value to learn from.
5355             sub _compute_impute_fill {
5356 12     12   27 my ( $self, $data ) = @_;
5357 12         25 my $nf = $self->{n_features};
5358 12         25 my $how = $self->{impute_with};
5359              
5360             # C fast path: walks the raw data directly and finds the median via
5361             # quickselect (O(n) average) instead of the Perl fallback's full sort
5362             # (O(n log n)). Produces the same fill values either way -- see
5363             # impute_fill_xs's file-top comment -- so use_c only changes speed
5364             # here, matching the rest of the module.
5365 12 100       36 if ( $self->{_use_c} ) {
5366 6         14 my $n = scalar @$data;
5367 6 100       58 my $how_flag = $how eq 'median' ? 1 : 0;
5368 6         11 my $fill = [];
5369 6         3683 impute_fill_xs( $data, $n, $nf, $how_flag, $fill );
5370 4         18 return $fill;
5371             }
5372              
5373 6         23 my @fill;
5374 6         21 for my $f ( 0 .. $nf - 1 ) {
5375 12         40 my @vals = grep { defined } map { $_->[$f] } @$data;
  2484         6379  
  2484         2860  
5376 12 100       469 croak "impute: feature column $f has no present values"
5377             unless @vals;
5378 10 100       26 if ( $how eq 'median' ) {
5379 4         1650 my @s = sort { $a <=> $b } @vals;
  2942         5748  
5380 4         15 my $k = scalar @s;
5381 4 100       47 $fill[$f]
5382             = $k % 2
5383             ? $s[ int( $k / 2 ) ]
5384             : ( $s[ $k / 2 - 1 ] + $s[ $k / 2 ] ) / 2.0;
5385             } else { # mean
5386 6         12 my $sum = 0;
5387 6         10 if (_NV_IS_DOUBLE) {
5388 6         111 $sum += $_ for @vals;
5389             } else {
5390             # impute_fill_xs accumulates the sum in double (over
5391             # SvNV-truncated cells); match its rounding step for step.
5392             $sum = _to_double( $sum + _to_double($_) ) for @vals;
5393             }
5394 6         18 $fill[$f] = $sum / scalar @vals;
5395             } ## end else [ if ( $how eq 'median' ) ]
5396              
5397             # The fill crosses into the C backend as a double (pack 'd' /
5398             # SvNV), so on wide-NV perls store it already narrowed and both
5399             # builders densify with the identical value.
5400 10         93 $fill[$f] = _to_double( $fill[$f] ) unless _NV_IS_DOUBLE;
5401             } ## end for my $f ( 0 .. $nf - 1 )
5402 4         17 return \@fill;
5403             } ## end sub _compute_impute_fill
5404              
5405             # Return a dense copy of $data with every undef cell replaced by the
5406             # matching per-feature fill value. Leaves present cells untouched.
5407             sub _densify {
5408 10     10   23 my ( $data, $fill ) = @_;
5409 10         25 my $nf = scalar @$fill;
5410             return [
5411             map {
5412 10         35 my $r = $_;
  1886         2081  
5413 1886 100       2239 [ map { defined $r->[$_] ? $r->[$_] : $fill->[$_] } 0 .. $nf - 1 ]
  4078         6955  
5414             } @$data
5415             ];
5416             } ## end sub _densify
5417              
5418             # (miss_mode, fill_packed) pair for pack_input_xs, per the active strategy.
5419             # die/zero -> 0 (undef becomes 0.0); impute -> 1 (undef becomes fill[k]);
5420             # nan -> 2 (undef becomes NaN, which the C scorer routes right).
5421             sub _pack_args {
5422 839     839   1728 my ($self) = @_;
5423 839         1956 my $m = $self->{missing};
5424 839 100       2214 return ( 2, '' ) if $m eq 'nan';
5425 830 100       1886 if ( $m eq 'impute' ) {
5426 9         25 my $fill = $self->{missing_fill};
5427             croak "impute model is missing its fill vector"
5428 9 50 33     55 unless ref $fill eq 'ARRAY' && @$fill == $self->{n_features};
5429 9   66     73 $self->{_fill_packed} //= pack( 'd*', @$fill );
5430 9         29 return ( 1, $self->{_fill_packed} );
5431             }
5432 821         2305 return ( 0, '' ); # die, zero
5433             } ## end sub _pack_args
5434              
5435             # Pure-Perl fallback input prep: arrayref-ify, then fill for impute so the
5436             # tree walk sees dense rows. zero/die rely on _path_length's "// 0"; nan
5437             # keeps undef in place for _path_length to route. Returns the rows; the
5438             # caller passes the nan flag to _path_length separately.
5439             sub _prepare_perl_input {
5440 78     78   173 my ( $self, $data ) = @_;
5441 78         369 my $rows = $self->_to_arrayref($data);
5442 78 100       259 if ( $self->{missing} eq 'impute' ) {
5443             croak "impute model is missing its fill vector"
5444 3 50       16 unless ref $self->{missing_fill} eq 'ARRAY';
5445 3         13 $rows = _densify( $rows, $self->{missing_fill} );
5446             }
5447 78         162 return $rows;
5448             } ## end sub _prepare_perl_input
5449              
5450             # Minimal PackedData package: opaque token returned by pack_data().
5451             # Exposes n_pts and n_feats accessors for users who want to introspect.
5452             {
5453              
5454             package Algorithm::Classifier::IsolationForest::PackedData;
5455 4     4   592 sub n_pts { $_[0]->{n_pts} }
5456 4     4   19 sub n_feats { $_[0]->{n_feats} }
5457             }
5458              
5459             1;