view release on metacpan or  search on metacpan

t/32-pack-data.t  view on Meta::CPAN

#!perl
# 32-pack-data.t
#
# Verifies pack_data + accept-packed semantics on the five scoring
# methods: passing the PackedData wrapper produces the same results
# as passing the original arrayref, on the same model.

use strict;
use warnings;
use Test::More;
use List::Util qw(sum);

use Algorithm::Classifier::IsolationForest;

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

plan skip_all => 'pack_data requires the Inline::C backend'
	unless $Algorithm::Classifier::IsolationForest::HAS_C;

# Small but non-trivial dataset: 200 Gaussian-ish inliers + 5 outliers
# in 4 dims.  Enough that scoring exercises the C path meaningfully but
# fast enough to keep the test snappy.
sub gaussian {
	my ( $mu, $sigma ) = @_;
	my $u1 = rand() || 1e-12;
	my $u2 = rand();
	return $mu + $sigma * sqrt( -2 * log($u1) ) * cos( 2 * 3.14159265358979 * $u2 );
}

srand(123);
my @train;
push @train, [ map { gaussian( 0, 1 ) } 1 .. 4 ] for 1 .. 200;
push @train, [ map { 6 + rand() } 1 .. 4 ]       for 1 .. 5;

my $f = $CLASS->new( n_trees => 100, sample_size => 256, seed => 7 );
$f->fit( \@train );

# Query data: mix of inlier-like + a couple of obvious outliers.
srand(456);
my @query;
push @query, [ map { gaussian( 0, 1 ) } 1 .. 4 ] for 1 .. 50;
push @query, [  7, -7,  6, -6 ];
push @query, [ -8,  8, -7,  7 ];

# ----- pack_data sanity -----
my $packed = $f->pack_data( \@query );
isa_ok( $packed, 'Algorithm::Classifier::IsolationForest::PackedData', 'pack_data returns a PackedData' );
is( $packed->n_pts,   scalar @query, 'PackedData->n_pts matches' );
is( $packed->n_feats, 4,             'PackedData->n_feats matches' );

# ----- score_samples -----
subtest 'score_samples: packed == arrayref' => sub {
	my $sa = $f->score_samples( \@query );
	my $sp = $f->score_samples($packed);
	is( scalar @$sa, scalar @$sp, 'same length' );
	my $diffs = grep { $sa->[$_] != $sp->[$_] } 0 .. $#$sa;
	is( $diffs, 0, 'every score matches bit-for-bit' );
};

# ----- predict -----
subtest 'predict: packed == arrayref' => sub {
	my $la = $f->predict( \@query, 0.55 );
	my $lp = $f->predict( $packed, 0.55 );
	is( scalar @$la, scalar @$lp, 'same length' );
	my $diffs = grep { $la->[$_] != $lp->[$_] } 0 .. $#$la;
	is( $diffs, 0, 'every label matches' );