view release on metacpan or  search on metacpan

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

}

# -----------------------------------------------------------------------
# Per-dataset test battery
# -----------------------------------------------------------------------
sub run_dataset_tests {
	my ( $ds, $sk_all, $use_c ) = @_;

	my $label = $ds->{label};
	my $n_in  = $ds->{n_in};
	my $n_out = $ds->{n_out};

	my $f = $CLASS->new(
		n_trees     => 100,
		sample_size => 256,
		seed        => 42,
		use_c       => $use_c
	);
	$f->fit( $ds->{data} );

	my $perl_in_scores  = $f->score_samples( $ds->{inliers} );
	my $perl_out_scores = $f->score_samples( $ds->{outliers} );
	my $perl_all_scores = $f->score_samples( $ds->{data} );

	my @sk_in  = @{$sk_all}[ 0 .. $n_in - 1 ];
	my @sk_out = @{$sk_all}[ $n_in .. $n_in + $n_out - 1 ];

	subtest 'Perl: outliers score clearly higher than inliers' => sub {
		cmp_ok(
			mean(@$perl_out_scores), '>',
			mean(@$perl_in_scores) + 0.2,
			'mean outlier Perl score exceeds mean inlier score by at least 0.2'
		);
		cmp_ok( min(@$perl_out_scores), '>', max(@$perl_in_scores),
			'every outlier has a strictly higher Perl score than every inlier' );
	};

	subtest 'sklearn: outliers score clearly lower (more anomalous) than inliers' => sub {
		cmp_ok( mean(@sk_out), '<', mean(@sk_in),
			'mean outlier sklearn score is lower (more anomalous) than mean inlier score' );
		cmp_ok( max(@sk_out), '<', min(@sk_in),
			'every outlier has a strictly lower sklearn score than every inlier' );
	};

	subtest "both models rank all $n_out outliers in the top-$n_out anomalies" => sub {
		# Perl: sort by descending score; highest scores are the most anomalous.
		my @perl_rank = sort { $perl_all_scores->[$b] <=> $perl_all_scores->[$a] } 0 .. $#$perl_all_scores;
		my %perl_top  = map  { $_ => 1 } @perl_rank[ 0 .. $n_out - 1 ];

		# sklearn: sort by ascending score; lowest scores are the most anomalous.
		my @sk_rank = sort { $sk_all->[$a] <=> $sk_all->[$b] } 0 .. $#$sk_all;
		my %sk_top  = map  { $_ => 1 } @sk_rank[ 0 .. $n_out - 1 ];

		my $perl_caught = grep { $perl_top{$_} } $n_in .. $n_in + $n_out - 1;
		my $sk_caught   = grep { $sk_top{$_} } $n_in .. $n_in + $n_out - 1;

		is( $perl_caught, $n_out, "Perl top-$n_out contains all $n_out outlier points" );
		is( $sk_caught,   $n_out, "sklearn top-$n_out contains all $n_out outlier points" );
	}; ## end "both models rank all $n_out outliers in the top-$n_out anomalies" => sub

	subtest 'Perl predict at 0.5 threshold flags all outliers and almost no inliers' => sub {
		my $in_labels  = $f->predict( $ds->{inliers} );
		my $out_labels = $f->predict( $ds->{outliers} );

		is( sum(@$out_labels), $n_out, "Perl predict() flags all $n_out outliers at the 0.5 threshold" );
		cmp_ok( sum(@$in_labels), '<', 0.05 * $n_in, 'fewer than 5% of inliers are flagged by Perl predict()' );
	};

	subtest 'Spearman rank correlation between Perl and sklearn scores >= 0.85' => sub {
		# Negate sklearn scores so both vectors point in the same direction
		# (higher value = more anomalous) before ranking.
		my @neg_sk = map { -$_ } @$sk_all;
		my $rho    = spearman_rho( $perl_all_scores, \@neg_sk );
		cmp_ok( $rho, '>=', 0.85, sprintf( 'Spearman rho(Perl, -sklearn) = %.4f (must be >= 0.85)', $rho ) );
	};
} ## end sub run_dataset_tests

# -----------------------------------------------------------------------
# Run the battery for each dataset
# -----------------------------------------------------------------------
for my $be (@BACKENDS) {
	my ( $be_name, $USE_C ) = @$be;
	for my $ds (@datasets) {
		my $sk_all = $py->{ $ds->{label} };
		unless ( ref $sk_all eq 'ARRAY' && @$sk_all == @{ $ds->{data} } ) {
			fail("sklearn output missing or wrong length for dataset '$ds->{label}'");
			next;
		}
		subtest "[$be_name] $ds->{label} ($ds->{n_feat} features)" => sub {
			run_dataset_tests( $ds, $sk_all, $USE_C );
		};
	} ## end for my $ds (@datasets)
} ## end for my $be (@BACKENDS)

done_testing;