view release on metacpan or  search on metacpan

t/21-fit-from-csv.t  view on Meta::CPAN

		for ( 1 .. 16 ) { push @rows, [ 15 + rand(), 15 + rand() ]; push @truth, 1 }
		my $csv = write_csv( \@rows );

		my %args = (
			n_trees       => 100,
			sample_size   => 256,
			seed          => 42,
			contamination => 16 / scalar(@rows),
			use_c         => $USE_C,
		);
		my $stream = $CLASS->new(%args);
		$stream->fit_from_csv($csv);
		my $mem = $CLASS->new(%args);
		$mem->fit( \@rows );

		my $sp = $stream->predict( \@rows );
		my $mp = $mem->predict( \@rows );
		is_deeply( $sp, $mp,     'fit_from_csv and fit flag identical anomalies' );
		is_deeply( $sp, \@truth, 'and both flag exactly the true outliers' );
	}; ## end "[$be_name] same verdicts as fit() on the same data" => sub

	subtest "[$be_name] deterministic given seed" => sub {
		my ($rows) = make_dataset();
		my $csv    = write_csv($rows);
		my %args   = ( n_trees => 40, sample_size => 128, seed => 7, contamination => 0.05, use_c => $USE_C );

		my $a = $CLASS->new(%args);
		$a->fit_from_csv($csv);
		my $b = $CLASS->new(%args);
		$b->fit_from_csv($csv);
		is( $a->to_json, $b->to_json, 'identical model across two runs' );
	}; ## end "[$be_name] deterministic given seed" => sub

	subtest "[$be_name] contamination threshold is exact" => sub {
		my ($rows) = make_dataset();
		my $csv = write_csv($rows);

		# Against the very same forest, the streaming learner must land on the
		# identical cut the batch learner computes over all rows.
		for my $cont ( 0.01, 0.05, 0.1, 0.25, 0.5 ) {
			my $m = $CLASS->new(
				n_trees       => 60,
				sample_size   => 128,
				seed          => 5,
				contamination => $cont,
				use_c         => $USE_C,
			);
			$m->fit_from_csv($csv);
			my $streamed = $m->decision_threshold;
			ok( defined $streamed, "contamination=$cont learned a threshold" );

			delete @$m{qw(_c_nodes _c_coef_idx _c_coef_val)};
			$m->_learn_contamination_threshold($rows);
			my $batch = $m->decision_threshold;
			ok( abs( $streamed - $batch ) < 1e-12, "contamination=$cont matches batch learner" );
		} ## end for my $cont ( 0.01, 0.05, 0.1, 0.25, 0.5 )
	}; ## end "[$be_name] contamination threshold is exact" => sub

	subtest "[$be_name] tied scores across the boundary" => sub {
		# Identical rows produce identical scores, forcing a tie block straddling
		# the contamination rank -- the streaming learner's rare second pass.
		my @rows = ( ( [ 1, 1 ] ) x 40, map { [ 5 + $_ / 10, 5 + $_ / 10 ] } 1 .. 10 );
		my $csv  = write_csv( \@rows );
		my $m    = $CLASS->new(
			n_trees       => 40,
			sample_size   => 64,
			seed          => 9,
			contamination => 0.2,
			use_c         => $USE_C,
		);
		$m->fit_from_csv($csv);
		my $streamed = $m->decision_threshold;
		delete @$m{qw(_c_nodes _c_coef_idx _c_coef_val)};
		$m->_learn_contamination_threshold( \@rows );
		ok( abs( $streamed - $m->decision_threshold ) < 1e-12, 'tie-block threshold is exact' );
	}; ## end "[$be_name] tied scores across the boundary" => sub

	subtest "[$be_name] missing-value strategies" => sub {
		my @rows = ( [ 1.0, 2.0 ], [ 1.1, undef ], [ undef, 2.1 ], [ 1.2, 2.2 ], [ 1.15, 2.15 ] );
		my $csv  = write_csv( \@rows );

		# sample_size >= row count => every row (including the gaps) trains, so
		# 'die' rejects the missing cell it finds in a sampled row.
		my $die = $CLASS->new( n_trees => 8, sample_size => 8, seed => 1, missing => 'die', use_c => $USE_C );
		like( exception { $die->fit_from_csv($csv) }, qr/missing value/, "die strategy rejects gaps" );

		for my $mode (qw(zero nan impute)) {
			my $m = $CLASS->new( n_trees => 8, sample_size => 4, seed => 1, missing => $mode, use_c => $USE_C );
			is( exception { $m->fit_from_csv($csv) }, undef, "$mode strategy fits" );
			is( scalar @{ $m->{trees} },              8,     "$mode built its trees" );
			if ( $mode eq 'impute' ) {
				is( scalar @{ $m->{missing_fill} }, 2, 'impute learned a fill vector' );
			}
			my $s = $m->score_samples( [ [ 1.05, undef ], [ undef, 2.05 ] ] );
			is( scalar @$s, 2, "$mode scores rows with gaps" );
		} ## end for my $mode (qw(zero nan impute))
	}; ## end "[$be_name] missing-value strategies" => sub

	subtest "[$be_name] header option and feature_names" => sub {
		my @rows = map { [ $_, $_ + 1 ] } 1 .. 30;
		my $csv  = write_csv( \@rows, 'alpha,beta' );

		my $m = $CLASS->new( n_trees => 10, sample_size => 8, seed => 1, use_c => $USE_C );
		$m->fit_from_csv( $csv, header => 1 );
		is( $m->{n_features}, 2, 'header line skipped, width from data' );

		my $named = $CLASS->new(
			n_trees       => 10,
			sample_size   => 8,
			seed          => 1,
			feature_names => [qw(alpha beta)],
			use_c         => $USE_C,
		);
		is( exception { $named->fit_from_csv( $csv, header => 1 ) }, undef, 'matching feature_names fits' );

		my $bad = $CLASS->new(
			n_trees       => 10,
			sample_size   => 8,
			seed          => 1,
			feature_names => [qw(alpha beta gamma)],
			use_c         => $USE_C,