Algorithm-Classifier-IsolationForest
view release on metacpan or search on metacpan
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
#ifdef _OPENMP
#pragma omp parallel for schedule(dynamic) if(use_openmp)
#endif
for (int t = 0; t < n_trees; t++) {
/* Seeded from the tree index, not thread id or iteration order,
* so the mapping from tree -> RNG stream is independent of
* OMP_NUM_THREADS / scheduling. sm64_next() mixes once more so
* adjacent tree indices (which differ by one golden-ratio step)
* don't start from too-similar states. */
uint64_t rng = base_seed + (uint64_t)t * 0x9E3779B97F4A7C15ULL;
rng = sm64_next(&rng);
int *all = (int*)malloc((size_t)n_pts * sizeof(int));
int *sample;
int i;
for (i = 0; i < n_pts; i++) all[i] = i;
for (i = 0; i < psi; i++) {
int j = i + (int)(sm64_drand(&rng) * (n_pts - i));
int tmp = all[i]; all[i] = all[j]; all[j] = tmp;
}
sample = (int*)malloc((size_t)psi * sizeof(int));
memcpy(sample, all, (size_t)psi * sizeof(int));
free(all);
_build_node_packed(x, n_feats, sample, psi, 0, limit, mode_flag,
ext_level, &bufs[t], &rng);
}
for (t = 0; t < n_trees; t++) {
/* newSVpvn(NULL, 0) makes an undef SV, not an empty-string one --
* axis-mode trees never call tb_push_coef, so idx/val stay NULL.
* Pass "" instead so the Perl side's unpack('...', $sv) always
* gets a defined (if empty) string, never undef. */
av_store(nodes_av, t, newSVpvn((char*)bufs[t].nodes,
bufs[t].n_nodes * 6 * sizeof(double)));
av_store(idx_av, t, bufs[t].n_idx
? newSVpvn((char*)bufs[t].idx, bufs[t].n_idx * sizeof(int))
: newSVpvn("", 0));
av_store(val_av, t, bufs[t].n_val
? newSVpvn((char*)bufs[t].val, bufs[t].n_val * sizeof(double))
: newSVpvn("", 0));
tb_free(&bufs[t]);
}
free(bufs);
}
/* ---------------------------------------------------------------------
* pack_tree_xs(root_rv, n_features, nodes_sv, idx_sv, val_sv)
*
* C image of _pack_tree: flattens one tree into the three packed buffers
* the scorer walks. _rebuild_c_trees runs it once per tree at the end of
* every fit() and every from_json(), and in Perl each node costs a
* recursive closure call, an arrayref and six SVs, plus a trailing map
* that pushes every one of those SVs back onto the stack for pack() --
* which made it the largest single phase of an axis-mode fit. This is
* the same walk done in C, appending into the TreeBuf above and handing
* the three buffers back as plain strings.
*
* The layout is unchanged: nodes are numbered DFS pre-order (a node's
* record is reserved before its children recurse, so the root is 0 and
* every child index sits above its parent's -- unlike the post-order
* _build_node_packed above), oblique coefficients dense-pack in feature
* order when a node uses every feature, and a leaf's slot 2 carries
* c(size). Output is byte-identical to the Perl path.
*
* The Perl side only calls this on nvsize == 8 perls: c(size) is computed
* here in C doubles, and a wide-NV perl's _c() keeps extra low bits, so
* the stored leaf adjustment would otherwise differ in the last ulp
* between backends -- the same parity concern _NV_IS_DOUBLE guards
* everywhere else.
* ------------------------------------------------------------------ */
/* Scratch reused across every node of a tree, so packing a node
* allocates nothing. Grown on demand rather than sized once from
* n_features: a model saved before n_features was persisted packs with
* n_features == -1, which leaves no up-front bound on an oblique node's
* coefficient count. */
typedef struct {
double *dense; /* coefficients by feature index, for the dense pack */
int *order; /* 0..cap-1 -- the dense pack's index array */
int *ix; /* sparse pack scratch */
double *cv;
int cap;
} PackScratch;
static void ps_init(PackScratch *s) {
s->dense = NULL; s->order = NULL; s->ix = NULL; s->cv = NULL; s->cap = 0;
}
static void ps_free(PackScratch *s) {
free(s->dense); free(s->order); free(s->ix); free(s->cv);
}
static void ps_reserve(PackScratch *s, int n) {
int k;
if (n <= s->cap) return;
s->dense = (double*)realloc(s->dense, (size_t)n * sizeof(double));
s->order = (int*) realloc(s->order, (size_t)n * sizeof(int));
s->ix = (int*) realloc(s->ix, (size_t)n * sizeof(int));
s->cv = (double*)realloc(s->cv, (size_t)n * sizeof(double));
for (k = s->cap; k < n; k++) s->order[k] = k;
s->cap = n;
}
/* c(n) -- the expression _c() evaluates, operation for operation. */
static double _pt_c(double n) {
double harmonic;
if (n <= 1.0) return 0.0;
if (n == 2.0) return 1.0;
harmonic = log(n - 1.0) + 0.5772156649015329;
return 2.0 * harmonic - (2.0 * (n - 1.0) / n);
}
/* Appends the subtree rooted at node_rv to buf; returns its node index. */
static int _pack_node_xs(pTHX_ SV* node_rv, int n_features, TreeBuf* b,
PackScratch* s) {
AV* node;
SV** slots;
int type, my_idx;
double* rec;
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
split. 0 behaves like a single-feature (axis) cut; the
maximum (n_features - 1) uses every varying feature. undef
=> maximum. Clamped to [0, n_features - 1] at fit time.
- contamination :: expected fraction of anomalies, in (0, 0.5]. When given,
fit() learns a score threshold that flags this fraction of
the training set, and predict() uses it by default. undef
=> no learned threshold (predict() falls back to 0.5).
default :: undef
- missing :: how fit() treats undef (missing) feature cells. Scoring always
tolerates undef regardless of this setting; it governs fit().
die :: croak from fit() if the training data contains any
undef cell. Scoring still maps undef to 0 (the
long-standing behaviour), so a model fitted on clean
data can still score rows with missing features.
zero :: treat a missing cell as the value 0, at fit and score.
impute :: replace a missing cell with the per-feature mean (or
median, see impute_with) learned from the present
values at fit time. The fill vector is stored on the
model and reused for scoring and persistence.
nan :: build feature ranges from present values only and route
a point missing the split feature to the right child,
consistently at fit and score time. Missingness is
preserved as signal rather than filled.
default :: die
- impute_with :: 'mean' or 'median'; the statistic used to compute the
per-feature fill under missing => 'impute'. Ignored otherwise.
default :: mean
- voting :: how the per-tree results are aggregated at scoring time.
Trees are built identically in both settings -- only aggregation
changes -- so the knob composes with either mode (axis or
extended) and an existing model may switch it after the fact with
set_voting() (which relearns a contamination threshold for the
new mode).
mean :: classic Isolation Forest: a sample's path lengths
across all trees are averaged and normalised into
one anomaly score; predict() thresholds that score.
majority :: Majority Voting Isolation Forest (MVIForest;
Chabchoub, Togbe, Boly & Chiky 2022 -- see
REFERENCES). Each tree scores the sample on its own
(s_i = 2**(-h_i / c(psi))) and votes it anomalous
when s_i >= the decision threshold; predict() flags
the sample when more than half of the trees
(int(n_trees/2) + 1) vote anomalous, and stops
walking trees per sample as soon as the outcome is
decided. The threshold argument/default of the
predict methods is therefore the PER-TREE cutoff
here, not a forest-level score cutoff.
score_samples() returns the fraction of trees
voting anomalous -- still in [0, 1], but discrete
in steps of 1/n_trees. contamination composes: fit()
learns the per-tree cutoff that flags the requested
fraction of the training set.
default :: mean
- parallel_fit :: positive integer N => build the trees across N forked
worker processes during fit(). Each worker gets a derived seed
(parent seed + worker_id * 1009) so the parallel fit is
reproducible across runs at fixed worker count -- but the trees
produced are NOT bit-identical to a serial fit with the same
seed, because the RNG draws happen in a different order.
Inference is unaffected. Falls back silently to serial on
platforms without a real fork() (e.g. Windows without Cygwin).
default :: undef (serial)
- use_c :: boolean, override whether the Inline::C backend is used for
both scoring and fit()'s tree builder. When false the instance
falls back to pure Perl for both even if the C backend compiled
successfully. When true (or unset) the C backend is used if
available ($HAS_C). fit() with use_c on produces bit-identical
trees to use_c off for the same seed -- only build speed differs.
default :: $HAS_C
- use_openmp :: boolean, override whether OpenMP parallel scoring is
used inside score_all_xs(). When false the C tree walk runs
single-threaded even if OpenMP was linked in. Ignored when
use_c is false (pure Perl has no OpenMP path).
default :: $HAS_OPENMP
- use_openmp_fit :: boolean, build fit()'s trees across OpenMP threads
(one tree per thread) instead of the single-threaded C builder.
Opt-in and off by default: unlike use_c/use_openmp, this changes
which trees get built. Perl's RNG isn't safe to call from
multiple OS threads sharing one interpreter, so this path seeds
an independent PRNG per tree from the tree index rather than
Drand01() -- trees differ from the use_c (single-threaded)
and pure-Perl paths even with the same seed, though a fixed
seed and n_trees still reproduce the same trees regardless of
OMP_NUM_THREADS or scheduling. Does NOT compose with
parallel_fit: a forked child starting its own OpenMP region
after the parent process has used OpenMP for anything can
hang (a general fork()+libgomp limitation), so parallel_fit's
workers always use the single-threaded C builder regardless
of this setting -- setting both just means parallel_fit wins.
Ignored (clamped to 0) when use_c is false or OpenMP isn't
linked in.
default :: 0
- feature_names :: optional arrayref of per-feature labels enabling the
*_tagged methods (and required by mungers below).
default :: undef
- mungers :: optional hashref of declarative L<Algorithm::ToNumberMunger>
specs, keyed as that module's compile() expects (scalar mungers by
their output tag, expanding mungers by any label with an 'into'
list, combining mungers by their output tag with a 'from' list).
When set, every tagged row -- the *_tagged methods, fit_tagged,
and tagged_row_to_array -- is munged from raw values (strings,
timestamps, status codes, ...) into numbers through the compiled
plan, and munge_rows() applies the scalar mungers to positional
rows. Requires feature_names; the plan compiles against them, so
any spec error croaks here in new(). Algorithm::ToNumberMunger is
an optional dependency, required only when a spec is given (or a
loaded model carrying one is used with tagged data). The spec is
saved with the model, so a loaded model munges scoring input
exactly as it did training input. See L</MUNGERS> for details
and caveats.
default :: undef
- schema_version :: optional opaque string identifying the revision of
the variable schema this model was built against. Never parsed
or compared numerically; saved with the model and shown by
`iforest info`. Usually set from a prototype (see
L</PROTOTYPES>) rather than passed directly.
default :: undef
- schema_description :: optional opaque free-text description of what
the variable schema is. Same handling as schema_version.
default :: undef
- feature_descriptions :: optional hashref of 'feature name => free
text' describing individual features. Requires feature_names;
every key must name an entry there (a description for a feature
that does not exist croaks -- it is either a typo or a stale
leftover from a schema change). Partial coverage is fine.
Saved with the model and shown beside each tag by
`iforest info`.
default :: undef
Note: log2 under Perl is as below...
log($psi) / log(2)
=cut
sub new {
my ( $class, %args ) = @_;
my $mode = $args{mode} // 'axis';
croak "mode must be 'axis' or 'extended'"
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
# my $baselines = $self->_ablation_baselines; # [ 0.5, 0.5, 1.0 ]
sub _ablation_baselines {
my ($self) = @_;
my $nf = $self->{n_features};
for my $candidate ( $self->{feature_baselines}, $self->{missing_fill} ) {
return $candidate if ref $candidate eq 'ARRAY' && @$candidate == $nf;
}
croak "explain_samples: this model has no stored feature baselines "
. "(saved by a version before ablation explanation support?); "
. "refit to enable method => 'ablation', or explain with "
. "method => 'path'";
} ## end sub _ablation_baselines
# Recursively convert a version-0 hash-based tree node to the version-1
# array format. Called by from_json when loading an old saved model.
#
# Args:
# $node :: a version-0 node hashref. A leaf carries leaf and size; an
# axis node attr, split, left and right; an oblique node idx,
# coef, b, left and right.
#
# Returns: the same subtree in the version-1 arrayref layout -- [0, size],
# [1, attr, split, left, right] or [2, \@idx, \@coef, b, left, right].
#
# Example:
# _hash_node_to_array( { leaf => 1, size => 3 } ); # [ 0, 3 ]
sub _hash_node_to_array {
my ($node) = @_;
if ( $node->{leaf} ) {
return [ _NODE_LEAF, $node->{size} ];
} elsif ( exists $node->{attr} ) {
return [
_NODE_AXIS, $node->{attr},
$node->{split}, _hash_node_to_array( $node->{left} ),
_hash_node_to_array( $node->{right} ),
];
} else {
return [
_NODE_OBLIQUE, $node->{idx}, $node->{coef}, $node->{b},
_hash_node_to_array( $node->{left} ),
_hash_node_to_array( $node->{right} ),
];
}
} ## end sub _hash_node_to_array
# ---------------------------------------------------------------------------
# _pack_tree($root) -- flatten one tree into three packed buffers.
#
# Returns ($nodes_packed, $idx_packed, $val_packed) where:
# nodes_packed: 6 doubles per node (see score_all_xs comment above)
# idx_packed: int32 feature indices for every oblique-node coefficient
# val_packed: double values matching idx_packed one-for-one
#
# Storing idx and val in separate buffers (SoA) instead of interleaved
# doubles lets the oblique dot product's SIMD inner loop run over a
# contiguous val[] stream without a per-iteration (int) cast, and
# halves the index bandwidth (int32 vs double). The same `coff`
# offset addresses paired entries in both buffers.
#
# Nodes are numbered in DFS pre-order: the root is always index 0 and
# children always get indices larger than their parent's.
#
# The C backend does this walk in pack_tree_xs, which is what actually
# runs whenever it is available -- the Perl body below is the fallback
# (no C backend, or a wide-NV perl, where the two would disagree on
# c(size) in the last ulp; see _NV_IS_DOUBLE). Both produce byte-
# identical buffers on an nvsize == 8 perl.
#
# Args:
# $root :: the tree's root node, in the nested arrayref layout
# _build_tree produces.
# $n_features :: the model's feature count, or undef. Only used to spot
# the dense-pack opportunity described above; passing
# undef just skips that optimisation.
#
# Returns: the three-element list ($nodes_packed, $idx_packed,
# $val_packed) -- a 'd*' string of 6 doubles per node, an 'l*' string of
# int32 feature indices, and a 'd*' string of the matching coefficients.
# The latter two are empty strings for an axis-mode tree.
#
# Example:
# my ( $np, $ip, $vp ) = _pack_tree( $self->{trees}[0], $self->{n_features} );
# length($np) / ( 6 * 8 ); # node count
# ---------------------------------------------------------------------------
sub _pack_tree {
my ( $root, $n_features ) = @_;
if ( $HAS_C && _NV_IS_DOUBLE ) {
my ( $nodes_packed, $idx_packed, $val_packed ) = ( '', '', '' );
pack_tree_xs( $root, $n_features // -1, $nodes_packed, $idx_packed, $val_packed );
return ( $nodes_packed, $idx_packed, $val_packed );
}
my ( @node_data, @coef_idx, @coef_val );
my $assign;
$assign = sub {
my ($node) = @_;
my $my_idx = scalar @node_data;
push @node_data, undef; # reserve slot; filled in after children
if ( $node->[0] == _NODE_LEAF ) {
# Slot 2 carries c(size) precomputed, so the C scoring loop
# adds it straight to the depth instead of paying a log()
# per point per tree at every leaf hit. _c is the same
# function the pure-Perl scorer uses, so both backends keep
# producing bit-identical path lengths.
$node_data[$my_idx] = [ 0.0, $node->[1] + 0.0, _c( $node->[1] ), 0.0, 0.0, 0.0 ];
} elsif ( $node->[0] == _NODE_AXIS ) {
my $li = $assign->( $node->[3] );
my $ri = $assign->( $node->[4] );
$node_data[$my_idx] = [
1.0,
$node->[1] + 0.0, # attr
$node->[2] + 0.0, # split
$li + 0.0,
$ri + 0.0,
0.0,
];
} else { # _NODE_OBLIQUE
lib/Algorithm/Classifier/IsolationForest.pm view on Meta::CPAN
mungers => $mungers,
);
} ## end sub _compile_mungers
# The compiled plan for this model, or undef when no mungers are
# configured. Compiled lazily (memoised in _munger_plan) so from_json
# does not need Algorithm::ToNumberMunger installed unless tagged data
# is actually used; new() populates the slot eagerly instead, surfacing
# spec errors at construction.
#
# A plain function rather than a method, like the two helpers above, so the
# Online class can hand it its own $self.
#
# Args: none beyond the model, which is passed positionally.
#
# Returns: the compiled Algorithm::ToNumberMunger plan, or undef when the
# model carries no munger spec. The plan is memoised in _munger_plan, so
# the compile happens at most once per model.
#
# Example:
# if ( my $plan = _plan($self) ) {
# my $vec = $plan->apply_named( { method => 'GET', host => 'h' } );
# }
sub _plan {
my ($self) = @_;
return undef unless $self->{mungers};
$self->{_munger_plan} //= _compile_mungers( $self->{feature_names}, $self->{mungers} );
return $self->{_munger_plan};
}
# Memoised "does this perl have a real fork()?". False on Windows
# without Cygwin; true on every Unix-like platform. fit() consults it
# before honouring parallel_fit, which is how that option degrades to a
# serial fit instead of failing.
#
# Args: none.
#
# Returns: 1 when Config's d_fork is defined, 0 otherwise. Config is
# loaded on the first call only and the answer cached for the process.
#
# Example:
# $self->_fit_trees_parallel(...) if $workers > 1 && _fork_supported();
{
my $cached;
sub _fork_supported {
return $cached if defined $cached;
require Config;
$cached
= ( ( $Config::Config{d_fork} || '' ) eq 'define' ) ? 1 : 0;
return $cached;
}
}
#-------------------------------------------------------------------------------
# Fork-based parallel tree builder. Used by fit() when parallel_fit > 1
# and the platform has a real fork(). Divides n_trees evenly among
# workers; each child seeds its own RNG ($seed + worker_id * 1009 so
# fixed-worker-count runs are reproducible), builds its share (via the
# C builder when _use_c is on, same as the non-parallel path), and
# returns the trees to the parent via Storable on a one-shot pipe.
#
# The trees that come back differ from a serial fit with the same seed
# because the RNG draws happen in a different order -- this is documented
# as part of the parallel_fit contract.
#
# Args:
# $data :: the prepared training set, an arrayref of feature-value
# arrayrefs. Each worker inherits it through the fork, so it is
# never serialised.
# $psi :: the per-tree sub-sample size from _resolve_geometry.
# $limit :: the tree height limit from _resolve_geometry.
# $workers :: how many children to fork. Clamped down to n_trees, since
# a worker with no trees to build is pure overhead.
#
# Returns: an arrayref of all n_trees trees in worker order -- worker 0's
# share first, then worker 1's, and so on, which is what makes the forest
# reproducible. Croaks when a fork or pipe fails, when a worker exits
# non-zero, or when its trees come back unreadable.
#
# Example:
# $self->{trees} = $self->_fit_trees_parallel( $train, 256, 8, 4 );
#-------------------------------------------------------------------------------
sub _fit_trees_parallel {
my ( $self, $data, $psi, $limit, $workers ) = @_;
require Storable;
require POSIX;
my $n_trees = $self->{n_trees};
$workers = $n_trees if $workers > $n_trees;
# Divide n_trees as evenly as possible across workers.
my @shares;
{
my $base = int( $n_trees / $workers );
my $extras = $n_trees - $base * $workers;
for my $w ( 0 .. $workers - 1 ) {
push @shares, $base + ( $w < $extras ? 1 : 0 );
}
}
my @procs; # { pid, rh, share }
for my $w ( 0 .. $workers - 1 ) {
my $share = $shares[$w];
next unless $share > 0;
pipe( my $rh, my $wh ) or croak "pipe failed: $!";
my $pid = fork();
croak "fork failed: $!" unless defined $pid;
if ( $pid == 0 ) {
# child
close $rh;
binmode $wh;
if ( defined $self->{seed} ) {
srand( $self->{seed} + $w * 1009 );
}
# Deliberately never _build_forest_openmp here, even when
# use_openmp_fit is on: if this process (or the parent that
# fork()ed us) already ran any OpenMP region before this
# fork -- including plain score_samples()/predict() with
# the default use_openmp -- libgomp's thread pool exists
# but its worker threads didn't survive the fork. A child
# starting its own #pragma omp parallel region then tries
# to reuse that now-invalid pool and hangs. This is a
# general fork()+libgomp limitation, not fixable from here,
# so forked workers always use the single-threaded C
# builder (or pure Perl) instead. See t/03-fit-determinism.t
# and the NATIVE ACCELERATION docs for the observed hang and
# why parallel_fit + use_openmp_fit isn't composed for real.
my $trees;
if ( $self->{_use_c} ) {
$trees = $self->_build_forest_c( $data, $psi, $limit, $share );
} else {
my @t;
for ( 1 .. $share ) {
my $sample = _subsample( $data, $psi );
push @t, $self->_build_tree( $sample, 0, $limit );
}
$trees = \@t;
}
print $wh Storable::freeze($trees);
close $wh;
# _exit so we don't run parent END/DESTROY in the child.
POSIX::_exit(0);
} ## end if ( $pid == 0 )
close $wh;
binmode $rh;
push @procs, { pid => $pid, rh => $rh, share => $share };
} ## end for my $w ( 0 .. $workers - 1 )
# Collect from each pipe in worker order so the canonical tree
# ordering is deterministic (worker 0's trees first, then 1's, ...).
my @all_trees;
for my $p (@procs) {
my $buf;
{
local $/;
$buf = readline( $p->{rh} );
}
close $p->{rh};
waitpid( $p->{pid}, 0 );
my $exit = $? >> 8;
croak "parallel_fit worker $p->{pid} exited with status $exit"
if $exit != 0;
my $trees = eval { Storable::thaw($buf) };
croak "parallel_fit worker $p->{pid} returned unparseable trees: $@"
if $@ || ref $trees ne 'ARRAY';
push @all_trees, @$trees;
} ## end for my $p (@procs)
return \@all_trees;
} ## end sub _fit_trees_parallel
#-------------------------------------------------------------------------------
# C-accelerated fit(): builds $n_trees trees against $data (a subset or
# the full training set) via build_forest_xs, which does its own
# per-tree subsampling internally. Random draws inside the C builder
# go through Drand01() -- the same generator Perl's rand() uses -- in
# the same call order _subsample/_build_tree used, so the returned
# trees are bit-identical to what the pure-Perl path would build from
# the same RNG state. That's what lets fit() switch backends on the
# existing `use_c` knob instead of a new one.
#
# Args:
# $data :: the prepared training set, an arrayref of feature-value
# arrayrefs. Packed into a flat double buffer here, so undef
# cells are resolved through _pack_args.
# $psi :: the per-tree sub-sample size from _resolve_geometry.
# $limit :: the tree height limit from _resolve_geometry.
# $n_trees :: how many trees to build. A forked worker passes its own
# share rather than the model's full n_trees.
#
# Returns: an arrayref of $n_trees trees in the nested arrayref layout
# _build_tree produces, so callers cannot tell which backend built them.
#
# Example:
# $self->{trees} = $self->_build_forest_c( $train, 256, 8, 100 );
#-------------------------------------------------------------------------------
sub _build_forest_c {
my ( $self, $data, $psi, $limit, $n_trees ) = @_;
my $n = scalar @$data;
my $nf = $self->{n_features};
my $x_packed = "\0" x ( $n * $nf * 8 );
my ( $mode, $fill ) = $self->_pack_args;
pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
my $ext_level = $self->{extension_level_used} // 0;
my $trees = [];
build_forest_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit, $mode_flag, $ext_level, $trees );
return $trees;
} ## end sub _build_forest_c
#-------------------------------------------------------------------------------
# OpenMP-parallel fit(): builds $n_trees trees across OpenMP threads (one
# tree per thread) via build_forest_openmp_xs. Unlike _build_forest_c,
# random draws come from a thread-private PRNG seeded per tree index
# rather than Drand01() -- Perl's RNG state can't be shared safely
# across OpenMP threads -- so the resulting trees are NOT bit-identical
# to the use_c (serial) or pure-Perl paths for the same seed, though a
# fixed seed + n_trees still reproduce the same trees regardless of
# OMP_NUM_THREADS. This is why it's gated by the separate, opt-in
# use_openmp_fit knob rather than reusing use_c/use_openmp.
#
# Only called from fit()'s non-forked branch. _fit_trees_parallel's
# workers never call this, even when use_openmp_fit is on: a forked
# child starting its own OpenMP region after the parent process has
# used OpenMP for anything (this includes plain score_samples()) can
# hang -- see the comment above that branch for the fork()+libgomp
# hazard this avoids.
#
# build_forest_openmp_xs hands back three arrayrefs of per-tree packed
# buffers (the same SoA layout _pack_tree produces) instead of Perl tree
# structures -- that's how it avoids any Perl API call inside its
# parallel region. _unpack_forest converts them back into the ordinary
# nested-arrayref tree shape so to_json/from_json/_rebuild_c_trees don't
# need to know this path exists.
#
# Args:
# $data :: the prepared training set, an arrayref of feature-value
# arrayrefs. Packed into a flat double buffer here, so undef
# cells are resolved through _pack_args.
# $psi :: the per-tree sub-sample size from _resolve_geometry.
# $limit :: the tree height limit from _resolve_geometry.
# $n_trees :: how many trees to build.
#
# Returns: an arrayref of $n_trees trees in the same nested arrayref layout
# _build_forest_c returns -- identical in shape, though not in content, to
# what the other backends would have built for this seed.
#
# Example:
# $self->{trees} = $self->_build_forest_openmp( $train, 256, 8, 100 );
#-------------------------------------------------------------------------------
sub _build_forest_openmp {
my ( $self, $data, $psi, $limit, $n_trees ) = @_;
my $n = scalar @$data;
my $nf = $self->{n_features};
my $x_packed = "\0" x ( $n * $nf * 8 );
my ( $mode, $fill ) = $self->_pack_args;
pack_input_xs( $data, $x_packed, $n, $nf, $mode, $fill );
my $mode_flag = $self->{mode} eq 'extended' ? 1 : 0;
my $ext_level = $self->{extension_level_used} // 0;
my ( @nodes, @idx, @val );
build_forest_openmp_xs( $x_packed, $n, $nf, $n_trees, $psi, $limit,
$mode_flag, $ext_level, \@nodes, \@idx, \@val, 1 );
return _unpack_forest( \@nodes, \@idx, \@val );
} ## end sub _build_forest_openmp
# Inverse of _pack_tree's SoA layout: given one tree's packed node
# buffer plus the shared idx/val coefficient buffers, reconstructs the
# ordinary nested-arrayref tree structure _build_tree/_build_node_c
# produce. li/ri fields hold the child's absolute node index, so this
# just follows them recursively from whatever index the caller says the
# root lives at. NOTE: _pack_tree numbers nodes DFS pre-order (root at
# 0), but build_forest_openmp_xs appends nodes post-order (children
# before parent), putting the root LAST -- the caller must pass the
# right root index for the buffer's origin.
#
# Args:
# $nodes :: arrayref of the tree's node doubles, already unpacked, 6 per
# node.
# $idx :: arrayref of the unpacked int32 coefficient feature indices.
# $val :: arrayref of the unpacked coefficient values, matching $idx
# one-for-one.
# $node_i :: which node record to treat as this subtree's root, counting
# in nodes not doubles.
#
# Returns: the subtree as a nested arrayref in _build_tree's layout.
#
# Example:
# my $root = @nodes / 6 - 1; # post-order buffer: root is last
# my $tree = _unpack_node( \@nodes, \@idx, \@val, $root );
sub _unpack_node {
my ( $nodes, $idx, $val, $node_i ) = @_;
my $off = $node_i * 6;
my $type = $nodes->[$off];
if ( $type == 0 ) {
return [ _NODE_LEAF, int( $nodes->[ $off + 1 ] ) ];
} elsif ( $type == 1 ) {
my ( $attr, $split, $li, $ri )
= @{$nodes}[ $off + 1 .. $off + 4 ];
return [
_NODE_AXIS, int($attr), $split,
_unpack_node( $nodes, $idx, $val, int($li) ),
_unpack_node( $nodes, $idx, $val, int($ri) ),
];
} else {
my ( $coff, $num, $li, $ri, $b ) = @{$nodes}[ $off + 1 .. $off + 5 ];
$coff = int($coff);
$num = int($num);
return [
_NODE_OBLIQUE,
[ @{$idx}[ $coff .. $coff + $num - 1 ] ],
[ @{$val}[ $coff .. $coff + $num - 1 ] ],
$b,
_unpack_node( $nodes, $idx, $val, int($li) ),
_unpack_node( $nodes, $idx, $val, int($ri) ),
];
} ## end else [ if ( $type == 0 ) ]
} ## end sub _unpack_node
# Unpacks every tree in the three per-tree packed-buffer arrayrefs
# build_forest_openmp_xs returns into the ordinary nested tree shape.
# The C builder pushes nodes post-order (a node is recorded after both
# of its children), so each tree's root is the LAST node record, not
# index 0 as in _pack_tree's pre-order layout.
#
# Args:
# $nodes_list :: arrayref of one packed 'd*' node buffer per tree.
# $idx_list :: arrayref of one packed 'l*' coefficient index buffer per
# tree, positionally matching $nodes_list.
# $val_list :: arrayref of one packed 'd*' coefficient value buffer per
# tree, positionally matching $nodes_list.
#
# Returns: an arrayref of trees in the nested arrayref layout, in the same
( run in 0.430 second using v1.01-cache-2.11-cpan-80ec619307d )