view release on metacpan or  search on metacpan

t/80-sklearn-comparison-online.t  view on Meta::CPAN

# Calibration measurements behind the thresholds (2026-07-08, prove -Ilib,
# rho at the warm-up + 10/25/50/75/100% checkpoints; "gap" is mean outlier
# score minus mean inlier score at 100%; two different deterministic stream
# shuffles shown for the final rho to expose the order sensitivity):
#
#   dataset            eta  warmup  rho @ checkpoints                final(alt)  gap
#   2d,  200 inliers    8   0.116   0.877 0.840 0.857 0.875 0.890     0.946     0.297
#   5d, 1000 inliers    8   0.054   0.750 0.791 0.808 0.811 0.807     0.897     0.133
#   10d, 1000 inliers  32   0.050   0.704 0.786 0.781 0.805 0.811     0.852     0.163
#   20d, 1000 inliers   8   0.023   0.600 0.642 0.669 0.702 0.707     0.737     0.128
#
# Ceiling-vs-dimension context (do NOT tighten the high-d floors upward --
# these plateaus persist regardless of eta, growth mode, or N):
#
#   2d ~0.95   5d ~0.90   10d ~0.85   20d ~0.73   30d ~0.65
#
# Per-dimension eta choice: small eta (deeper trees) wins at low dimension,
# larger eta (better-estimated splits) wins around 10 features.  Assertion
# floors sit ~0.08-0.10 under the WORST measured shuffle because both the
# stream order and Perl's platform-dependent rand() (Drand01) move the
# final rho by several hundredths across systems.

use strict;
use warnings;
use Test::More;
use List::Util qw(sum min max);
use File::Temp qw(tempfile);
use JSON::PP   ();

use Algorithm::Classifier::IsolationForest::Online;

my $CLASS = 'Algorithm::Classifier::IsolationForest::Online';

use constant PI => 3.14159265358979;

# Stream fractions at which the online model is checkpointed against sklearn.
my @CHECKPOINTS = ( 0.10, 0.25, 0.50, 0.75, 1.00 );

# How far a checkpoint's rho may fall below its predecessor before it counts
# as a collapse rather than normal wobble (largest measured dip: 0.037).
use constant STEP_TOLERANCE => 0.10;

# How much the final rho must exceed the warm-up rho.  Measured improvements
# are 0.68-0.77; warm-up rho itself measured 0.02-0.12.
use constant APPROACH_MARGIN => 0.35;

# -----------------------------------------------------------------------
# Helpers (spearman_rho and friends match t/80-sklearn-comparison.t)
# -----------------------------------------------------------------------
sub mean { @_ ? sum(@_) / @_ : 0 }

# Assign 1-based ranks; lower value gets lower rank.
sub _assign_ranks {
	my @v   = @_;
	my @idx = sort { $v[$a] <=> $v[$b] } 0 .. $#v;
	my @r;
	$r[ $idx[$_] ] = $_ + 1 for 0 .. $#idx;
	return @r;
}

# Pearson correlation of two rank vectors (= Spearman rho of the originals).
sub spearman_rho {
	my ( $xs, $ys ) = @_;
	my @rx = _assign_ranks(@$xs);
	my @ry = _assign_ranks(@$ys);
	my $n  = scalar @rx;
	my ( $sa, $sb, $saa, $sbb, $sab ) = (0) x 5;
	for my $i ( 0 .. $n - 1 ) {
		$sa  += $rx[$i];
		$sb  += $ry[$i];
		$saa += $rx[$i]**2;
		$sbb += $ry[$i]**2;
		$sab += $rx[$i] * $ry[$i];
	}
	my ( $ma, $mb ) = ( $sa / $n, $sb / $n );
	my $cov = $sab / $n - $ma * $mb;
	my $da  = sqrt( $saa / $n - $ma**2 );
	my $db  = sqrt( $sbb / $n - $mb**2 );
	return ( $da > 0 && $db > 0 ) ? $cov / ( $da * $db ) : 0;
} ## end sub spearman_rho

sub gaussian {
	my ( $mu, $sigma ) = @_;
	return $mu + $sigma * sqrt( -2 * log( rand() || 1e-12 ) ) * cos( 2 * PI * rand() );
}

# -----------------------------------------------------------------------
# Datasets: N-D Gaussian inliers + corner-style outliers, the same shape
# t/80-sklearn-comparison.t uses (and the same srand convention), with the
# inlier count scaled up in higher dimensions so the online model's depth
# budget log4(N/eta) gives its trees enough resolution to rank inliers.
#
# Gaussian inliers (rather than the batch test's regular grid) in every
# dimension: the tier-2 rank correlation needs real density structure both
# models can rank, and ranking among identical-density grid points is noise.
#
# Per-dataset knobs:
#   eta     -- max_leaf_samples for the online model (see header)
#   rho_min -- tier-2 floor on the final-checkpoint Spearman rho
#   stream  -- deterministic shuffle of data, the learn order
# -----------------------------------------------------------------------
sub make_dataset {
	my (%spec) = @_;
	my ( $nf, $n_in ) = @spec{qw(n_feat n_in)};
	srand( 20260629 + $nf );

	my @inliers;
	push @inliers, [ map { gaussian( 0, 0.3 ) } 1 .. $nf ] for 1 .. $n_in;

	my @outliers;
	for ( 1 .. 8 ) {
		my @row;
		for ( 1 .. $nf ) {
			my $mag  = 5 + rand() * 3;
			my $sign = rand() > 0.5 ? 1 : -1;
			push @row, $mag * $sign;
		}
		push @outliers, \@row;
	}

	my @data = ( @inliers, @outliers );