view release on metacpan or  search on metacpan

examples/basic-anomaly-detection.pl  view on Meta::CPAN

#!/usr/bin/env perl

# basic-anomaly-detection.pl
#
# The canonical use case: fit a forest on mostly-normal data, then score and
# label every point. Here we manufacture 500 "normal" points from a Gaussian
# blob at the origin and 20 "anomalies" scattered in a ring far from it, so we
# know the ground truth and can measure how well the forest recovers it.
#
# Run from the distribution root:
#     perl -Ilib examples/basic-anomaly-detection.pl
# or, if the module is installed:
#     perl examples/basic-anomaly-detection.pl

use strict;
use warnings;
use Algorithm::Classifier::IsolationForest;

use constant PI => 3.14159265358979;

# Seed the global RNG so the *data* is reproducible from run to run. The forest
# gets its own seed below; fit() reseeds internally, which is fine because the
# data has already been generated by then.
srand(7);

sub gaussian {
	my ( $mu, $sigma ) = @_;
	my $u1 = rand() || 1e-12;
	my $u2 = rand();
	return $mu + $sigma * sqrt( -2 * log($u1) ) * cos( 2 * PI * $u2 );
}

# --- build a labelled dataset -------------------------------------------------
my ( @data, @truth );

for ( 1 .. 500 ) {    # normal points: a unit Gaussian blob
	push @data,  [ gaussian( 0, 1 ), gaussian( 0, 1 ) ];
	push @truth, 0;
}
for ( 1 .. 20 ) {    # anomalies: a ring at radius 5..8
	my $angle  = rand() * 2 * PI;
	my $radius = 5 + rand() * 3;
	push @data,  [ $radius * cos($angle), $radius * sin($angle) ];
	push @truth, 1;
}

# --- train --------------------------------------------------------------------
my $iforest = Algorithm::Classifier::IsolationForest->new(
	n_trees     => 100,
	sample_size => 256,
	seed        => 42,
);
$iforest->fit( \@data );

# --- score and label ----------------------------------------------------------
my $scores = $iforest->score_samples( \@data );    # each in (0, 1]
my $labels = $iforest->predict( \@data, 0.6 );     # 1 = anomaly, 0 = normal

# --- how did we do? -----------------------------------------------------------
my ( $tp, $fp, $fn, $tn ) = ( 0, 0, 0, 0 );
for my $i ( 0 .. $#data ) {
	my ( $p, $t ) = ( $labels->[$i], $truth[$i] );
	if    ( $t && $p )  { $tp++ }
	elsif ( $t && !$p ) { $fn++ }
	elsif ( !$t && $p ) { $fp++ }
	else                { $tn++ }
}