view release on metacpan or  search on metacpan

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

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

		$out = `$^X -Ilib $bin fit -i $csv -p --voting bogus -s 5 2>&1`;
		isnt( $?, 0, 'fit --voting bogus exits non-zero' );
		like( $out, qr/must be either mean or majority/, 'bogus voting value is rejected' );
	}; ## end 'CLI fit --voting' => sub
} ## end SKIP:

# ------------------------------------------------------------------------
# CLI: set_voting flips a saved model, recalibrating when contamination
# was set and refusing to guess a threshold without the training data.
# ------------------------------------------------------------------------
SKIP: {
	my $bin = File::Spec->rel2abs('bin/iforest');
	skip "bin/iforest not found", 1 unless -x $bin;

	subtest 'CLI set_voting' => sub {
		require File::Temp;
		my ( $cfh, $csv ) = File::Temp::tempfile( SUFFIX => '.csv', UNLINK => 1 );
		print $cfh join( ',', @$_ ) . "\n" for @data;
		close $cfh;

		# A model with no contamination flips without needing the data, and
		# carries no threshold to recalibrate.
		my ( undef, $free ) = File::Temp::tempfile( SUFFIX => '.json', UNLINK => 1 );
		system("$^X -Ilib $bin fit -i $csv -o $free -w --voting mean -s 5 >/dev/null 2>&1");
		my $out = `$^X -Ilib $bin set_voting -m $free --voting majority 2>&1`;
		is( $?, 0, 'set_voting on a non-contamination model exits 0' );
		my $info = `$^X -Ilib $bin info -m $free 2>&1`;
		like( $info, qr/voting\s+majority/, 'model was rewritten as majority in place' );

		# A contamination model refuses to switch without -i...
		my ( undef, $cm ) = File::Temp::tempfile( SUFFIX => '.json', UNLINK => 1 );
		system("$^X -Ilib $bin fit -i $csv -o $cm -w --voting mean -c 0.05 -s 42 -n 60 >/dev/null 2>&1");
		$out = `$^X -Ilib $bin set_voting -m $cm --voting majority 2>&1`;
		isnt( $?, 0, 'switching a contamination model without -i exits non-zero' );
		like( $out, qr/-i CSV training data is required/, 'the error names the missing -i data' );

		# ...but succeeds with -i, and the recalibrated threshold matches a
		# model fit directly as majority with the same knobs.
		$out = `$^X -Ilib $bin set_voting -m $cm --voting majority -i $csv -p 2>&1`;
		is( $?, 0, 'set_voting --voting majority -i exits 0' );
		like( $out, qr/"voting"\s*:\s*"majority"/, 'printed model records voting => majority' );

		# fit.pm leaves sample_size at the module default, so match only the