view release on metacpan or  search on metacpan

t/90-cli-commands.t  view on Meta::CPAN

# --- 2. fit (a known-good command) --------------------------------------
subtest 'fit produces a model' => sub {
	my $out = `$^X -Ilib $bin fit -i $train_csv -o $model -n 30 -m 16 -s 42 2>&1`;
	is( $?, 0, 'fit exits 0' );
	ok( -s $model, 'model.json was written' );
};

# --- 3. info ------------------------------------------------------------
subtest 'info dumps model metadata' => sub {
	my $out = `$^X -Ilib $bin info -m $model 2>&1`;
	is( $?, 0, 'info exits 0' );
	like( $out, qr/n_trees\s+30/,           'info reports n_trees=30' );
	like( $out, qr/n_features\s+3/,         'info reports n_features=3' );
	like( $out, qr/mode\s+axis/,            'info reports mode=axis' );
	like( $out, qr/tree_total_nodes\s+\d+/, 'info reports a tree_total_nodes count' );
};

subtest 'info --json emits parseable JSON' => sub {
	my $out = `$^X -Ilib $bin info -m $model --json 2>&1`;
	is( $?, 0, 'info --json exits 0' );
	require JSON::PP;
	my $obj = eval { JSON::PP->new->decode($out) };
	ok( !$@, 'output parses as JSON' ) or diag("error: $@");
	is( $obj->{n_trees}, 30,     'JSON n_trees matches' ) if $obj;
	is( $obj->{mode},    'axis', 'JSON mode matches' )    if $obj;
};

# --- 3b. info reports feature-name tags --------------------------------
subtest 'info displays tag info' => sub {
	# The baseline model was fit without -t, so it is untagged.
	my $out = `$^X -Ilib $bin info -m $model 2>&1`;
	like( $out, qr/tagged\s+0/, 'untagged model reports tagged=0' );
	unlike( $out, qr/feature_names/, 'untagged model omits the feature_names block' );

	# Fit a tagged model over the same 3-feature CSV.
	my $tagged = "$tmp/tagged.json";
	my $fit    = `$^X -Ilib $bin fit -i $train_csv -o $tagged -n 30 -m 16 -s 42 -t cpu -t mem -t disk 2>&1`;
	is( $?, 0, 'tagged fit exits 0' ) or diag($fit);

	my $t = `$^X -Ilib $bin info -m $tagged 2>&1`;
	is( $?, 0, 'info on tagged model exits 0' );
	like( $t, qr/tagged\s+1/,                     'reports tagged=1' );
	like( $t, qr/feature_names\s+cpu, mem, disk/, 'lists the joined tags' );
	like( $t, qr/\[0\]\s+cpu/,                    'lists tag [0] cpu' );
	like( $t, qr/\[1\]\s+mem/,                    'lists tag [1] mem' );
	like( $t, qr/\[2\]\s+disk/,                   'lists tag [2] disk' );

	# --json carries the same info in machine-readable form.
	my $j = `$^X -Ilib $bin info -m $tagged --json 2>&1`;
	require JSON::PP;
	my $obj = eval { JSON::PP->new->decode($j) };
	ok( !$@, 'tagged --json parses' ) or diag("error: $@");
	if ($obj) {
		is( $obj->{tagged}, 1, 'JSON tagged=1' );
		is_deeply( $obj->{feature_names}, [qw(cpu mem disk)], 'JSON feature_names matches tags' );
	}
}; ## end 'info displays tag info' => sub

# --- 4. bench -----------------------------------------------------------
subtest 'bench reports per-method ops/s' => sub {
	# Short --secs so the bench finishes quickly in CI.
	my $out = `$^X -Ilib $bin bench -m $model -i $query_csv --secs 0.3 2>&1`;
	is( $?, 0, 'bench exits 0' );
	like( $out, qr/score_samples\b/,       'mentions score_samples' );
	like( $out, qr/predict\b/,             'mentions predict' );
	like( $out, qr/score_predict_split\b/, 'mentions score_predict_split' );
	like( $out, qr/path_lengths\b/,        'mentions path_lengths' );
	like( $out, qr/ops\/s/,                'has ops/s column header' );
}; ## end 'bench reports per-method ops/s' => sub

# --- 5. pack + packed predict ------------------------------------------
SKIP: {
	skip 'pack requires Inline::C backend', 4
		unless $Algorithm::Classifier::IsolationForest::HAS_C;

	subtest 'pack writes a .iforest-packed file' => sub {
		my $out = `$^X -Ilib $bin pack -m $model -i $query_csv -o $packed 2>&1`;
		is( $?, 0, 'pack exits 0' );
		ok( -s $packed, 'packed file written' );

		# Verify magic bytes.
		open my $fh, '<:raw', $packed or die $!;
		my $magic;
		read( $fh, $magic, 8 );
		close $fh;
		is( $magic, "IFPKD\0\0\0", 'magic bytes match' );
	}; ## end 'pack writes a .iforest-packed file' => sub

	subtest 'predict consumes a packed input' => sub {
		my $out = `$^X -Ilib $bin predict -m $model -i $packed -o $pred_csv 2>&1`;
		is( $?, 0, 'predict (packed input) exits 0' );
		ok( -s $pred_csv, 'output prediction file written' );

		my @lines = do { open my $fh, '<', $pred_csv; <$fh> };
		is( scalar @lines, 7, 'predict emitted one row per query point (7)' );
		like( $lines[0], qr/^[\d.eE+-]+,[01]\s*$/, 'first row matches "score,label"' );
	};

	subtest 'predict on packed input agrees with CSV input' => sub {
		# Run predict against the raw CSV too and check the labels match.
		my $out = `$^X -Ilib $bin predict -m $model -i $query_csv -o $pred2_csv 2>&1`;
		is( $?, 0, 'predict (CSV input) exits 0' );

		my @a = do { open my $fh, '<', $pred_csv;  <$fh> };
		my @b = do { open my $fh, '<', $pred2_csv; <$fh> };
		is( scalar @a, scalar @b, 'same row count' );

		my $diffs = 0;
		for my $i ( 0 .. $#a ) {
			chomp( my $la = $a[$i] );
			chomp( my $lb = $b[$i] );
			my ( $sa, $ya ) = split /,/, $la;
			my ( $sb, $yb ) = split /,/, $lb;
			$diffs++ if abs( $sa - $sb ) > 1e-9;
			$diffs++ if $ya != $yb;
		}
		is( $diffs, 0, 'packed-input scores and labels match CSV-input output' );
	}; ## end 'predict on packed input agrees with CSV input' => sub

	subtest 'predict with -d works on packed input' => sub {
		my $out = `$^X -Ilib $bin predict -m $model -i $packed -d 2>&1`;
		is( $?, 0, 'predict -d (packed) exits 0' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 7, 'one row per query point' );
		my $first = $lines[0];
		my @f     = split /,/, $first;
		is( scalar @f, 5, '-d output has 3 features + score + label (5 columns)' );
	};
} ## end SKIP:

# --- explain ------------------------------------------------------------
subtest 'explain reports per-feature attributions' => sub {
	my $out = `$^X -Ilib $bin explain -m $model -i $query_csv 2>&1`;
	is( $?, 0, 'explain exits 0' );
	my @lines = grep { length } split /\n/, $out;
	is( scalar @lines, 7 * 3, 'one line per (row, feature) pair' );
	my @first = split /,/, $lines[0], -1;
	is( scalar @first, 8, 'ablation output has 8 columns' );
	is( $first[0],     1, 'row numbers are 1-based' );
	is( $first[2],     1, 'first line per row is rank 1' );
}; ## end 'explain reports per-feature attributions' => sub

subtest 'explain -t explains only flagged rows, -n limits features' => sub {

	# The two planted outliers score ~0.64-0.69 in this fixture, the
	# inliers stay at or below ~0.50 -- 0.6 splits them cleanly.
	my $out = `$^X -Ilib $bin explain -m $model -i $query_csv -t 0.6 -n 1 2>&1`;
	is( $?, 0, 'explain -t exits 0' );
	my @lines = grep { length } split /\n/, $out;
	is( scalar @lines, 2, 'only the two outliers explained, one feature each' );
	like( $lines[0], qr/^6,/, 'row numbers reference the input rows' );
	like( $lines[1], qr/^7,/, 'second flagged row keeps its input row number' );
}; ## end 'explain -t explains only flagged rows, -n limits features' => sub

subtest 'explain --method path works' => sub {
	my $out = `$^X -Ilib $bin explain -m $model -i $query_csv --method path -n 1 2>&1`;
	is( $?, 0, 'explain --method path exits 0' );
	my @lines = grep { length } split /\n/, $out;
	is( scalar @lines, 7, 'one line per row with -n 1' );
	my $cols = () = split /,/, $lines[0], -1;
	is( $cols, 6, 'path output has 6 columns (no delta/baseline)' );

	my $bad = `$^X -Ilib $bin explain -m $model -i $query_csv --method voodoo 2>&1`;
	isnt( $?, 0, 'unknown --method exits non-zero' );
	like( $bad, qr/must be either 'path' or 'ablation'/, 'and names the valid methods' );
}; ## end 'explain --method path works' => sub

# --- online model workflow: stream + info -------------------------------
{
	my $stream_csv = "$tmp/stream.csv";
	my $omodel     = "$tmp/online_model.json";
	my $oscores    = "$tmp/stream_scores.csv";

	{
		open my $fh, '>', $stream_csv or die $!;
		srand(3);
		for ( 1 .. 120 ) {
			print $fh join( ',', map { sprintf( '%.4f', rand() - 0.5 ) } 1 .. 3 ), "\n";
		}
		print $fh "9,9,9\n";
		close $fh;
	}

	subtest 'stream creates an online model and emits prequential scores' => sub {
		my $out = `$^X -Ilib $bin stream -i $stream_csv -m $omodel -n 20 --window 64 --eta 16 -s 42 2>&1`;
		is( $?, 0, 'stream exits 0' );
		ok( -s $omodel, 'online model was written' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 121, 'one output row per input row' );
		like( $lines[-1], qr/^[\d.eE+-]+,[01]$/, 'rows match "score,label"' );
	};

	subtest 'stream resumes a saved model' => sub {
		my $out = `$^X -Ilib $bin stream -i $stream_csv -m $omodel 2>&1`;
		is( $?, 0, 'stream (resume) exits 0' );
		my @lines = split /\n/, $out;
		is( scalar @lines, 121, 'one output row per input row on resume' );
	};

	subtest 'stream --score-only does not advance the model' => sub {
		my $before = do { local ( @ARGV, $/ ) = ($omodel); <> };
		my $out    = `$^X -Ilib $bin stream --score-only -i $stream_csv -m $omodel -o $oscores 2>&1`;
		is( $?, 0, 'stream --score-only exits 0' );
		ok( -s $oscores, 'score output file written' );
		my $after = do { local ( @ARGV, $/ ) = ($omodel); <> };
		is( $after, $before, 'model file unchanged by --score-only' );
	};

	subtest 'stream --learn-only emits nothing but updates the model' => sub {
		my $before = do { local ( @ARGV, $/ ) = ($omodel); <> };
		my $out    = `$^X -Ilib $bin stream --learn-only -i $stream_csv -m $omodel 2>&1`;
		is( $?,   0,  'stream --learn-only exits 0' );