view release on metacpan or  search on metacpan

lib/Algorithm/Classifier/IsolationForest/App/Command/info.pm  view on Meta::CPAN

package Algorithm::Classifier::IsolationForest::App::Command::info;

use strict;
use warnings;
use Algorithm::Classifier::IsolationForest ();
use Algorithm::Classifier::IsolationForest::App -command;

sub opt_spec {
	return (
		[
			'm=s',
			'Input model JSON file path/name.',
			{ 'default' => 'iforest_model.json', 'completion' => 'files' }
		],
		[ 'json', 'Emit machine-readable JSON instead of the text table.' ],
	);
} ## end sub opt_spec

sub abstract { 'Show the constructor params, fit-time metadata, and tree stats of a saved model' }

sub description {
	'Loads a saved Algorithm::Classifier::IsolationForest model and prints the
constructor params, fit-time metadata, and a handful of derived tree
statistics (count, average/max depth, total nodes).

Use --json for a machine-readable dump suitable for piping into jq.
'
}

sub validate {
	my ( $self, $opt, $args ) = @_;

	if ( !-f $opt->{'m'} ) {
		$self->usage_error( '-m, "' . $opt->{'m'} . '", is not a file or does not exist' );
	} elsif ( !-r $opt->{'m'} ) {
		$self->usage_error( '-m, "' . $opt->{'m'} . '", is not readable' );
	}
	return 1;
} ## end sub validate

# Tree-shape stats are derived once at load time.  Each tree is a
# nested arrayref structure -- leaf [0, size] or interior [1, ...] /
# [2, ...] with children at fixed slots.
sub _walk_tree {
	my ( $node, $depth, $acc ) = @_;
	$acc->{nodes}++;
	if ( $node->[0] == 0 ) {    # leaf
		$acc->{leaves}++;
		$acc->{max_depth} = $depth if $depth > $acc->{max_depth};
		$acc->{depth_sum} += $depth;
		return;
	}
	# Axis interior nodes have children at slots 3,4; oblique at 4,5.
	my ( $li, $ri ) = $node->[0] == 1 ? ( 3, 4 ) : ( 4, 5 );
	_walk_tree( $node->[$li], $depth + 1, $acc );
	_walk_tree( $node->[$ri], $depth + 1, $acc );
} ## end sub _walk_tree

sub _tree_stats {
	my ($trees) = @_;
	my $acc = { nodes => 0, leaves => 0, max_depth => 0, depth_sum => 0 };
	_walk_tree( $_, 0, $acc ) for @$trees;
	return $acc;
}

# Summary of a model's Algorithm::ToNumberMunger spec as a flat
# 'key => munger name' map (the full spec can be arbitrarily large --
# frozen count tables and the like -- so info only names the mungers).
# Returns undef when the model carries none.
sub _munger_summary {
	my ($model) = @_;
	my $mungers = $model->{mungers};
	return undef unless ref $mungers eq 'HASH' && %$mungers;
	return { map { $_ => ( ref $mungers->{$_} eq 'HASH' ? $mungers->{$_}{munger} : undef ) } keys %$mungers };
}

# Text-table rendering of the summary, matching the feature_names style.
sub _print_mungers {
	my ($summary) = @_;
	return unless $summary;
	printf "  %-20s  %s\n", 'mungers', scalar( keys %$summary ) . ' configured';
	for my $k ( sort keys %$summary ) {
		printf "    %-18s  %s\n", $k, ( defined $summary->{$k} ? $summary->{$k} : '(?)' );
	}
	return;
}

# Online-model counterpart of _walk_tree: nodes are
# [0, count, lo, hi] / [1, count, lo, hi, attr, split, left, right],
# a tree record is { root, count, depth_limit }, and root may be undef
# on a tree that has not learned anything yet.
sub _walk_tree_online {
	my ( $node, $depth, $acc ) = @_;
	$acc->{nodes}++;
	if ( $node->[0] == 0 ) {    # leaf
		$acc->{leaves}++;
		$acc->{max_depth} = $depth if $depth > $acc->{max_depth};
		$acc->{depth_sum} += $depth;
		return;