view release on metacpan or  search on metacpan

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

	# 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};
			is( scalar @$fill, 2, 'fill vector has one entry per feature' );

			# Independently compute the expected statistic for each column.
			for my $col ( 0, 1 ) {
				my @present = grep { defined } map { $_->[$col] } @holey;
				my $want;
				if ( $how eq 'mean' ) {
					$want = sum(@present) / scalar @present;
				} else {
					my @s = sort { $a <=> $b } @present;
					my $n = scalar @s;
					$want
						= $n % 2
						? $s[ int( $n / 2 ) ]
						: ( $s[ $n / 2 - 1 ] + $s[ $n / 2 ] ) / 2;
				}
				cmp_ok( abs( $fill->[$col] - $want ), '<', 1e-12,
					"column $col fill is the $how of present values" );
			} ## end for my $col ( 0, 1 )

			# Densify with the learned fill, then a plain (die) fit must agree.
			my @densified = map {
				my $r = $_;
				[ map { defined $r->[$_] ? $r->[$_] : $fill->[$_] } 0, 1 ]
			} @holey;
			my $ref = $CLASS->new( n_trees => 80, seed => $SEED, use_c => $USE_C );
			$ref->fit( \@densified );

			cmp_ok( _max_abs_diff( $imp->score_samples( \@clean ), $ref->score_samples( \@clean ) ),
				'<', 1e-9, "impute ($how) scores match densified fit" );
		}; ## end "[$be_name] impute mode ($how) learns fill and matches densified fit" => sub
	} ## end for my $how (qw(mean median))

	# -----------------------------------------------------------------------
	# impute: a feature column that's entirely undef has no statistic to
	# learn, and must croak -- on the first such column in feature order,
	# matching the pure-Perl fallback's message exactly. This exercises
	# the multi-column case (one good column, one entirely-undef column)
	# specifically: an earlier regression in the C fast path freed a
	# good column's scratch buffer once when computing its fill and then
	# again while cleaning up after discovering the later, entirely-undef
	# column -- a double free that only shows up with more than one
	# feature column, so a single-column case wouldn't have caught it.
	# -----------------------------------------------------------------------
	subtest "[$be_name] impute mode croaks on a feature with no present values" => sub {
		my @all_missing_second = map { [ $_->[0], undef ] } @holey;
		my $f                  = $CLASS->new(
			n_trees => 20,
			seed    => $SEED,
			missing => 'impute',
			use_c   => $USE_C
		);
		ok( !eval { $f->fit( \@all_missing_second ); 1 }, 'fit croaks when a feature column is entirely undef' );
		like( $@, qr/impute: feature column 1 has no present values/, 'names the offending column' );

		my @all_missing_first = map { [ undef, $_->[1] ] } @holey;
		my $g                 = $CLASS->new(
			n_trees => 20,
			seed    => $SEED,
			missing => 'impute',
			use_c   => $USE_C
		);
		ok( !eval { $g->fit( \@all_missing_first ); 1 },
			'fit croaks when the first feature column is entirely undef' );
		like( $@, qr/impute: feature column 0 has no present values/, 'names the offending column' );
	}; ## end "[$be_name] impute mode croaks on a feature with no present values" => sub

	# -----------------------------------------------------------------------
	# Persistence: every strategy round-trips, and impute carries its fill
	# -----------------------------------------------------------------------
	subtest "[$be_name] save/load round-trips each strategy" => sub {
		for my $cfg ( [ zero => {} ], [ impute => { impute_with => 'median' } ], [ nan => {} ], ) {
			my ( $strategy, $extra ) = @$cfg;
			my $f = $CLASS->new(
				n_trees => 60,
				seed    => $SEED,
				missing => $strategy,
				use_c   => $USE_C,
				%$extra,
			);
			$f->fit( \@holey );
			my $reloaded = $CLASS->from_json( $f->to_json );

			is( $reloaded->{missing}, $strategy, "$strategy: missing restored" );
			if ( $strategy eq 'impute' ) {
				is_deeply( $reloaded->{missing_fill}, $f->{missing_fill}, 'impute: fill vector restored' );
			}

			cmp_ok( _max_abs_diff( $f->score_samples( \@test ), $reloaded->score_samples( \@test ) ),
				'<', 1e-9, "$strategy: reloaded scores match original" );
		} ## end for my $cfg ( [ zero => {} ], [ impute => {...}])
	}; ## end "[$be_name] save/load round-trips each strategy" => sub

	# -----------------------------------------------------------------------
	# Old models (no `missing` key) load as zero and keep undef -> 0 scoring
	# -----------------------------------------------------------------------
	subtest "[$be_name] pre-missing models default to zero on load" => sub {
		my $f    = $CLASS->new( n_trees => 40, seed => $SEED, use_c => $USE_C )->fit( \@clean );
		my $json = $f->to_json;

		# Strip the missing-value keys to mimic a model saved by an older release.
		$json =~ s/"missing"\s*:\s*"[^"]*"\s*,?//;
		$json =~ s/"impute_with"\s*:\s*"[^"]*"\s*,?//;
		$json =~ s/"missing_fill"\s*:\s*(?:null|\[[^\]]*\])\s*,?//;

		my $reloaded = $CLASS->from_json($json);
		is( $reloaded->{missing}, 'zero', 'legacy model loads as zero' );
		ok( eval { $reloaded->score_samples( \@test ); 1 }, 'legacy model scores undef rows' );
	}; ## end "[$be_name] pre-missing models default to zero on load" => sub
} ## end for my $be (@BACKENDS)

# ---------------------------------------------------------------------------
# nan: the C and pure-Perl backends must route missing values identically.