view release on metacpan or  search on metacpan

t/34-missing-values.t  view on Meta::CPAN

# failing.  The equivalence tests pin each strategy to its contract:
#   * zero   == fitting the same data with undef pre-replaced by 0
#   * impute == fitting the same data with undef pre-replaced by the fill
#   * nan     gives matching scores under the C and pure-Perl backends

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

use Algorithm::Classifier::IsolationForest;

my $CLASS = 'Algorithm::Classifier::IsolationForest';
my $SEED  = 42;
my $HAS_C = $Algorithm::Classifier::IsolationForest::HAS_C;

my @BACKENDS = ( [ 'pure-perl' => 0 ] );
push @BACKENDS, [ 'C' => 1 ] if $HAS_C;

# Helper: run a block, return any warnings it emitted.
sub _warnings {
	my ($code) = @_;
	my @w;
	local $SIG{__WARN__} = sub { push @w, @_ };
	$code->();
	return @w;
}

# Largest absolute elementwise difference between two score arrayrefs.
sub _max_abs_diff {
	my ( $x, $y ) = @_;
	my $max = 0;
	for my $i ( 0 .. $#$x ) {
		my $d = abs( $x->[$i] - $y->[$i] );
		$max = $d if $d > $max;
	}
	return $max;
}

# Clean 2-D training grid (no undef anywhere).
my @clean;
for my $i ( -7 .. 7 ) {
	for my $j ( -7 .. 7 ) {
		push @clean, [ $i / 7.0, $j / 7.0 ];
	}
}

# A copy of the grid with a scattering of undef cells punched into it.
my @holey = map { [@$_] } @clean;
for my $k ( 0 .. $#holey ) {
	$holey[$k][0] = undef if $k % 9 == 0;     # missing in column 0
	$holey[$k][1] = undef if $k % 13 == 0;    # missing in column 1
}

# Score-time test points, some with undef columns.
my @test = ( [ 0.3, 0.3 ], [ 6.0, 6.0 ], [ 0.3, undef ], [ undef, 0.5 ], [ undef, undef ], );

# ---------------------------------------------------------------------------
# Constructor validation (backend-independent)
# ---------------------------------------------------------------------------
subtest 'constructor validates missing / impute_with' => sub {
	ok( eval { $CLASS->new( missing  => 'zero' );  1 }, "missing => 'zero' accepted" );
	ok( eval { $CLASS->new( missing  => 'nan' );   1 }, "missing => 'nan' accepted" );
	ok( !eval { $CLASS->new( missing => 'bogus' ); 1 }, 'bad missing rejected' );
	like( $@, qr/missing must be one of/, 'bad missing message' );

	ok( eval { $CLASS->new( impute_with  => 'median' ); 1 }, "impute_with => 'median' accepted" );
	ok( !eval { $CLASS->new( impute_with => 'mode' );   1 }, 'bad impute_with rejected' );
	like( $@, qr/impute_with must be/, 'bad impute_with message' );

	is( $CLASS->new->{missing}, 'die', 'missing defaults to die' );
}; ## end 'constructor validates missing / impute_with' => sub

for my $be (@BACKENDS) {
	my ( $be_name, $USE_C ) = @$be;

	# -----------------------------------------------------------------------
	# die (default): fatal on undef in training, scoring still tolerates it
	# -----------------------------------------------------------------------
	subtest "[$be_name] die mode croaks on undef training data" => sub {
		my $f = $CLASS->new( n_trees => 50, seed => $SEED, use_c => $USE_C );
		ok( !eval { $f->fit( \@holey ); 1 }, 'fit on holey data croaks' );
		like( $@, qr/undef feature value at sample \d+, column \d+/, 'helpful croak message' );

		ok( eval { $f->fit( \@clean ); 1 }, 'fit on clean data succeeds' );

		# A model fitted on clean data still scores rows with missing
		# features, mapping undef -> 0 (the pre-existing behaviour).
		my @w = _warnings( sub { $f->score_samples( \@test ) } );
		is( scalar @w, 0, 'scoring undef rows emits no warnings under die mode' );
	}; ## end "[$be_name] die mode croaks on undef training data" => sub

	# -----------------------------------------------------------------------
	# zero: fitting on undef data == fitting on the same data with undef -> 0
	# -----------------------------------------------------------------------
	subtest "[$be_name] zero mode equals explicit-zero fit" => sub {
		my @zeroed = map {
			[ map { defined $_ ? $_ : 0 } @$_ ]
		} @holey;

		my $a = $CLASS->new(
			n_trees => 80,
			seed    => $SEED,
			missing => 'zero',
			use_c   => $USE_C
		);
		my @w = _warnings( sub { $a->fit( \@holey ) } );
		is( scalar @w, 0, 'zero-mode fit on undef data emits no warnings' );

		my $b = $CLASS->new( n_trees => 80, seed => $SEED, use_c => $USE_C );
		$b->fit( \@zeroed );    # die mode, clean zeroed data

		cmp_ok( _max_abs_diff( $a->score_samples( \@clean ), $b->score_samples( \@clean ) ),
			'<', 1e-9, 'zero-mode scores match explicit-zero fit' );
	}; ## end "[$be_name] zero mode equals explicit-zero fit" => sub

	# -----------------------------------------------------------------------
	# impute: fill is the per-feature statistic; fit == densify-then-fit
	# -----------------------------------------------------------------------
	for my $how (qw(mean median)) {
		subtest "[$be_name] impute mode ($how) learns fill and matches densified fit" => sub {
			my $imp = $CLASS->new(
				n_trees     => 80,
				seed        => $SEED,
				missing     => 'impute',
				impute_with => $how,
				use_c       => $USE_C,
			);
			my @w = _warnings( sub { $imp->fit( \@holey ) } );
			is( scalar @w, 0, "impute ($how) fit emits no warnings" );

			my $fill = $imp->{missing_fill};