view release on metacpan or  search on metacpan

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

	my $n = 0;
	$code->(), $n++ while time() - $t0 < $secs;
	return $n / ( time() - $t0 );
}

sub _read_csv {
	my ($path) = @_;
	my @data;
	my $expected;
	my $line = 0;
	for my $row ( read_file($path) ) {
		$line++;
		chomp $row;
		next if $row =~ /^\s*$/;
		my @f = split /,/, $row, -1;
		$expected //= scalar @f;
		die "line $line of '$path' has $row but expected $expected columns\n"
			if scalar @f != $expected;
		for my $v (@f) {
			die "line $line of '$path' value '$v' is not numeric\n"
				unless looks_like_number($v);
		}
		push @data, \@f;
	} ## end for my $row ( read_file($path) )
	return ( \@data, $expected );
} ## end sub _read_csv

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

	my $model = Algorithm::Classifier::IsolationForest->load( $opt->{'m'} );

	my ( $data, $cols ) = _read_csv( $opt->{'i'} );
	die "input CSV has $cols feature columns but model expects " . $model->{n_features} . "\n"
		if $cols != $model->{n_features};

	my $n_pts  = scalar @$data;
	my $secs   = $opt->{'secs'};
	my $thresh = $opt->{'t'};
	my $has_c  = $Algorithm::Classifier::IsolationForest::HAS_C ? 1 : 0;

	printf "Model:    %s  (n_trees=%d, mode=%s, n_features=%d)\n",
		$opt->{'m'},    scalar @{ $model->{trees} },
		$model->{mode}, $model->{n_features};
	printf "Input:    %s  (%d rows)\n", $opt->{'i'}, $n_pts;
	printf "Budget:   %.1fs per measurement (0.3s warm-up)\n", $secs;
	printf "Backend:  HAS_C=%d HAS_OPENMP=%d HAS_SIMD=%d\n\n",
		$has_c,
		$Algorithm::Classifier::IsolationForest::HAS_OPENMP ? 1 : 0,
		$Algorithm::Classifier::IsolationForest::HAS_SIMD   ? 1 : 0;

	# Pre-pack once (when C is available) so the *_packed rows measure
	# scoring in isolation, without the per-call pack_input_xs cost.
	my $packed = $has_c ? $model->pack_data($data) : undef;

	my @bench = (
		[ 'score_samples'         => sub { $model->score_samples($data) } ],
		[ 'predict'               => sub { $model->predict( $data, $thresh ) } ],
		[ 'score_predict_samples' => sub { $model->score_predict_samples( $data, $thresh ) } ],
		[ 'score_predict_split'   => sub { my @r = $model->score_predict_split( $data, $thresh ); } ],
		[ 'path_lengths'          => sub { $model->path_lengths($data) } ],
	);

	if ( defined $packed ) {
		push @bench,
			(
				[ 'score_samples (packed)'       => sub { $model->score_samples($packed) } ],
				[ 'predict (packed)'             => sub { $model->predict( $packed, $thresh ) } ],
				[ 'score_predict_split (packed)' => sub { my @r = $model->score_predict_split( $packed, $thresh ); } ],
			);
	}

	printf "  %-30s  %14s  %14s\n", 'method', 'ops/s',  'ms/call';
	printf "  %-30s  %14s  %14s\n", '-' x 30, '-' x 14, '-' x 14;
	for my $row (@bench) {
		my ( $label, $code ) = @$row;
		my $rate = _bench( $code, $secs );
		printf "  %-30s  %14.1f  %14.2f\n", $label, $rate, $rate > 0 ? 1000 / $rate : 0;
	}
	return 1;
} ## end sub execute

return 1;