view release on metacpan or  search on metacpan

t/02-accel-selection.t  view on Meta::CPAN

	my $f = $CLASS->new(
		n_trees     => 12,
		sample_size => 24,
		seed        => 5,
		use_c       => 0,
	);
	$f->fit( \@data );

	my $json     = $f->to_json;
	my $reloaded = $CLASS->from_json($json);
	is( $reloaded->{_use_c}, $HAS_C, 'from_json picks up the current $HAS_C, not the saved instance flag' );

	my $a = $f->score_samples( \@data );
	my $b = $reloaded->score_samples( \@data );
	is( scalar @$a, scalar @$b, 'same row count after reload' );
}; ## end 'use_c => 0 propagates through reload (from_json/load)' => sub

SKIP: {
	skip 'no Inline::C backend compiled in', 1 unless $HAS_C;

	subtest 'use_c => 1 honoured when $HAS_C is set' => sub {
		my $f = $CLASS->new(
			n_trees     => 20,
			sample_size => 32,
			seed        => 3,
			use_c       => 1,
		);
		is( $f->{_use_c}, 1, '_use_c is 1 after use_c => 1' );

		$f->fit( \@data );
		ok( ref $f->{_c_nodes} eq 'ARRAY' && @{ $f->{_c_nodes} }, 'fit() builds _c_nodes when use_c is on' );
	}; ## end 'use_c => 1 honoured when $HAS_C is set' => sub
} ## end SKIP:

SKIP: {
	skip 'use_c => 0 vs use_c => 1 comparison needs Inline::C', 1
		unless $HAS_C;

	subtest 'C-backed and Perl-fallback scores agree' => sub {
		# Identical seed + identical hyperparameters => identical trees =>
		# the two code paths should produce the same scores (up to the
		# tiny floating-point reordering inside score_all_xs vs the Perl
		# loop -- well under 1e-9 in practice for this scale).
		my $fc = $CLASS->new(
			n_trees     => 30,
			sample_size => 40,
			seed        => 17,
			use_c       => 1,
		);
		my $fp = $CLASS->new(
			n_trees     => 30,
			sample_size => 40,
			seed        => 17,
			use_c       => 0,
		);
		$fc->fit( \@data );
		$fp->fit( \@data );

		my $sc = $fc->score_samples( \@data );
		my $sp = $fp->score_samples( \@data );
		is( scalar @$sc, scalar @$sp, 'same length' );

		my $max_diff = 0;
		for my $i ( 0 .. $#$sc ) {
			my $d = abs( $sc->[$i] - $sp->[$i] );
			$max_diff = $d if $d > $max_diff;
		}
		cmp_ok( $max_diff, '<', 1e-9, "C and Perl scores agree (max diff $max_diff)" );

		# Labels at the default cutoff must match exactly.
		my $lc         = $fc->predict( \@data );
		my $lp         = $fp->predict( \@data );
		my $mismatches = grep { $lc->[$_] != $lp->[$_] } 0 .. $#$lc;
		is( $mismatches, 0, 'predict() labels agree across backends' );
	}; ## end 'C-backed and Perl-fallback scores agree' => sub
} ## end SKIP:

SKIP: {
	skip 'OpenMP not linked in', 1 unless $HAS_OPENMP;

	subtest 'use_openmp => 0 keeps C backend, disables parallel walk' => sub {
		my $f = $CLASS->new(
			n_trees     => 20,
			sample_size => 32,
			seed        => 3,
			use_openmp  => 0,
		);
		is( $f->{_use_c},      1, '_use_c stays on with use_openmp => 0' );
		is( $f->{_use_openmp}, 0, '_use_openmp is 0 after use_openmp => 0' );

		$f->fit( \@data );
		my $scores = $f->score_samples( \@data );
		is( scalar @$scores, scalar @data, 'serial C path still scores every sample' );
	}; ## end 'use_openmp => 0 keeps C backend, disables parallel walk' => sub

	subtest 'use_openmp => 1 honoured when $HAS_OPENMP is set' => sub {
		my $f = $CLASS->new(
			n_trees     => 20,
			sample_size => 32,
			seed        => 3,
			use_openmp  => 1,
		);
		is( $f->{_use_openmp}, 1, '_use_openmp is 1 after use_openmp => 1' );
	};
} ## end SKIP:

subtest 'use_openmp clamped to 0 when use_c is off' => sub {
	# OpenMP only matters with the C tree walk; if the C backend is off
	# the OpenMP flag is meaningless, so the constructor should clear it
	# rather than leaving it set to a value that never gets read.
	my $f = $CLASS->new(
		n_trees     => 10,
		sample_size => 16,
		seed        => 1,
		use_c       => 0,
		use_openmp  => 1,
	);
	is( $f->{_use_c},      0, '_use_c is 0' );
	is( $f->{_use_openmp}, 0, '_use_openmp clamped to 0 since C backend is off' );
}; ## end 'use_openmp clamped to 0 when use_c is off' => sub