view release on metacpan or  search on metacpan

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

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 );

	# Deterministic Fisher-Yates shuffle for the stream order.
	my @stream = @data;
	srand( 4242 + $nf );
	for my $i ( reverse 1 .. $#stream ) {
		my $j = int( rand( $i + 1 ) );
		@stream[ $i, $j ] = @stream[ $j, $i ];
	}

	return {
		%spec,
		label    => "${nf}d_gaussian",
		inliers  => \@inliers,
		outliers => \@outliers,
		data     => \@data,
		stream   => \@stream,
		n_out    => scalar @outliers,
	};
} ## end sub make_dataset

my @datasets = (
	make_dataset( n_feat => 2,  n_in => 200,  eta => 8,  rho_min => 0.80 ),
	make_dataset( n_feat => 5,  n_in => 1000, eta => 8,  rho_min => 0.72 ),
	make_dataset( n_feat => 10, n_in => 1000, eta => 32, rho_min => 0.70 ),
	make_dataset( n_feat => 20, n_in => 1000, eta => 8,  rho_min => 0.55 ),
);