view release on metacpan or  search on metacpan

t/37-majority-voting.t  view on Meta::CPAN

	ok( ( grep { $flags->[$_] == 1 } @outlier_idx ) == @outlier_idx, 'the planted outliers are flagged' );
}; ## end 'contamination learns a per-tree cutoff' => sub

subtest 'higher per-tree threshold never flags more points' => sub {
	my $f = $CLASS->new(
		n_trees     => 50,
		sample_size => 32,
		seed        => 31,
		voting      => 'majority',
	)->fit( \@data );

	my $low  = grep { $_ } @{ $f->predict( \@data, 0.45 ) };
	my $mid  = grep { $_ } @{ $f->predict( \@data, 0.55 ) };
	my $high = grep { $_ } @{ $f->predict( \@data, 0.70 ) };
	cmp_ok( $low, '>=', $mid,  'flag count non-increasing from 0.45 to 0.55' );
	cmp_ok( $mid, '>=', $high, 'flag count non-increasing from 0.55 to 0.70' );
}; ## end 'higher per-tree threshold never flags more points' => sub

subtest 'set_voting switches an existing model' => sub {
	# A model switched to a mode reproduces one fit directly in that mode:
	# the trees are voting-independent, and set_voting relearns the
	# contamination threshold against the same training data.
	my %args = (
		n_trees       => 100,
		sample_size   => 64,
		seed          => 42,
		contamination => 0.05,
	);

	my $ref = $CLASS->new( %args, voting => 'majority' )->fit( \@data );

	my $sw       = $CLASS->new( %args, voting => 'mean' )->fit( \@data );
	my $mean_thr = $sw->decision_threshold;
	is( $sw->set_voting( 'majority', \@data ), $sw,        'set_voting returns $self for chaining' );
	is( $sw->{voting},                         'majority', 'voting mode updated' );

	isnt(
		sprintf( '%.12g', $sw->decision_threshold ),
		sprintf( '%.12g', $mean_thr ),
		'threshold was recalibrated, not left at the mean value'
	);
	cmp_ok( abs( $sw->decision_threshold - $ref->decision_threshold ),
		'<', 1e-12, 'recalibrated threshold matches a model fit directly as majority' );

	my $lr       = $ref->predict( \@data );
	my $ls       = $sw->predict( \@data );
	my $mismatch = grep { $lr->[$_] != $ls->[$_] } 0 .. $#$lr;
	is( $mismatch, 0, 'switched model predicts identically to the reference' );

	# Switching back to mean relearns the mean-mode cutoff.
	$sw->set_voting( 'mean', \@data );
	cmp_ok( abs( $sw->decision_threshold - $mean_thr ),
		'<', 1e-12, 'switching back to mean restores the mean-mode threshold' );

	# A no-op switch needs no data and returns self.
	is( $sw->set_voting('mean'), $sw, 'switching to the current mode is a no-op returning $self' );

	# A contamination-fitted model refuses to switch without the data.
	my $need = $CLASS->new( %args, voting => 'majority' )->fit( \@data );
	eval { $need->set_voting('mean') };
	like( $@, qr/requires the original training data/, 'contamination model croaks without data' );
	is( $need->{voting}, 'majority', 'mode unchanged after the croak' );

	# A model with no contamination switches freely, no data required.
	my $free = $CLASS->new( n_trees => 50, sample_size => 32, seed => 7, voting => 'mean' )->fit( \@data );
	$free->set_voting('majority');
	is( $free->{voting},           'majority', 'non-contamination model switches without data' );
	is( $free->decision_threshold, undef,      'no threshold to recalibrate when contamination was never set' );

	# Invalid values are rejected.
	eval { $free->set_voting('plurality') };
	like( $@, qr/must be 'mean' or 'majority'/, 'invalid voting value croaks' );

	# Switching before fit just records the mode for the eventual fit.
	my $pre = $CLASS->new( n_trees => 20, sample_size => 16, seed => 5 );
	$pre->set_voting('majority');
	is( $pre->{voting}, 'majority', 'set_voting before fit records the mode' );
	$pre->fit( \@data );
	is( $pre->{voting}, 'majority', 'mode survives the subsequent fit' );
}; ## end 'set_voting switches an existing model' => sub

subtest 'tagged single-row helpers work under majority voting' => sub {
	my $f = $CLASS->new(
		n_trees       => 30,
		sample_size   => 32,
		seed          => 13,
		voting        => 'majority',
		feature_names => [qw(x y z)],
	)->fit( \@data );

	my $out   = { x => 12,  y => 12,  z => 12 };
	my $in    = { x => 0.5, y => 0.5, z => 0.5 };
	my $score = $f->score_sample_tagged($out);
	cmp_ok( $score, '>', 0.5, 'tagged outlier row has a majority vote fraction' );
	is( $f->predict_tagged($out), 1, 'tagged outlier row predicted anomalous' );
	is( $f->predict_tagged($in),  0, 'tagged inlier row predicted normal' );

	my $pair = $f->score_predict_sample_tagged($out);
	is( abs( $pair->[0] - $score ) < 1e-12 ? 1 : 0, 1, 'tagged pair score matches score_sample_tagged' );
	is( $pair->[1],                                 1, 'tagged pair label matches predict_tagged' );
}; ## end 'tagged single-row helpers work under majority voting' => sub

# ------------------------------------------------------------------------
# CLI: fit --voting must validate the value and store it on the model.
# ------------------------------------------------------------------------
SKIP: {
	my $bin = File::Spec->rel2abs('bin/iforest');
	skip "bin/iforest not found", 1 unless -x $bin;

	subtest 'CLI fit --voting' => sub {
		require File::Temp;
		my ( $fh, $csv ) = File::Temp::tempfile( SUFFIX => '.csv', UNLINK => 1 );
		for my $row (@data) {
			print $fh join( ',', @$row ) . "\n";
		}
		close $fh;

		my $out = `$^X -Ilib $bin fit -i $csv -p --voting majority -s 5 2>&1`;
		is( $?, 0, 'fit --voting majority exits 0' );
		like( $out, qr/"voting"\s*:\s*"majority"/, 'printed model records voting => majority' );