Algorithm-Classifier-NaiveBayes

 view release on metacpan or  search on metacpan

examples/basic.pl  view on Meta::CPAN

my @to_classify = ( 'cheap pills for sale', 'can we move the meeting to after lunch', 'you have won free pills', );

foreach my $text (@to_classify) {
	my $explanation = $nb->explain($text);
	my $class       = $explanation->{'class'};

	print '"' . $text . '" -> ' . $class . ', probability ' . sprintf( '%.3f', $explanation->{'probs'}{$class} ) . "\n";

	# show what each token contributed, sorted by how hard it pushed
	# towards the winning class over the runner up
	my ( $first, $second ) = sort { $explanation->{'scores'}{$b} <=> $explanation->{'scores'}{$a} }
		keys %{ $explanation->{'scores'} };
	my %pull;
	foreach my $token ( keys %{ $explanation->{'tokens'} } ) {
		my $contribs = $explanation->{'tokens'}{$token}{'contributions'};
		$pull{$token} = ( $contribs->{$first} - $contribs->{$second} ) * $explanation->{'tokens'}{$token}{'count'};
	}
	foreach my $token ( sort { $pull{$b} <=> $pull{$a} } keys %pull ) {
		my $towards = $pull{$token} > 0 ? $first : $second;
		print '    ' . $token . ' pushed towards ' . $towards . ' by ' . sprintf( '%.3f', abs( $pull{$token} ) ) . "\n";
	}
} ## end foreach my $text (@to_classify)

lib/Algorithm/Classifier/NaiveBayes.pm  view on Meta::CPAN

        is a hash ref with "count", how many times the token appeared
        in the text, and "contributions", a hash ref of the log
        probability that token added to each class per appearance.

For any class, the score is the prior plus count * contribution summed
over every token. A token pushes towards the class it has the highest,
closest to zero, contribution for. So finding the tokens most
responsible for a classification can be done like below.

    my $explanation = $nb->explain($text);
    my ( $first, $second ) =
        sort { $explanation->{'scores'}{$b} <=> $explanation->{'scores'}{$a} }
        keys %{ $explanation->{'scores'} };
    foreach my $token ( keys %{ $explanation->{'tokens'} } ) {
        my $contribs = $explanation->{'tokens'}{$token}{'contributions'};
        my $pull = ( $contribs->{$first} - $contribs->{$second} )
            * $explanation->{'tokens'}{$token}{'count'};
        print $token . ' pushed towards ' . $first . ' by ' . $pull . "\n";
    }

Will die if the text is undef. If nothing has been trained yet, undef
is returned.

=cut

sub explain {

lib/Algorithm/Classifier/NaiveBayes.pm  view on Meta::CPAN

	if ( defined( $args{'alpha'} ) ) {
		$self->{'model'}{'alpha'} = $args{'alpha'};
	}
	if ( defined( $args{'priors'} ) ) {
		$self->{'model'}{'priors'} = $args{'priors'};
	}
} ## end sub tweak

=head2 to_string

Returns the model as a JSON string. See the section MODEL FORMAT for
what the JSON looks like.

    my $json = $nb->to_string;

The JSON is generated with canonical set, so the keys are sorted,
meaning two calls against the same model will always produce identical
output, making it diffable.

If token_splitter or stop_regex was set to a qr// Regexp, it is
stringified, so the result is always JSON safe.

lib/Algorithm/Classifier/NaiveBayes/App/Command/explain.pm  view on Meta::CPAN

	}

	if ( $opt->{'json'} ) {
		print JSON::PP->new->canonical->pretty->encode($explanation);
		return;
	}

	my $class = $explanation->{'class'};
	print $class. ', probability ' . sprintf( '%.3f', $explanation->{'probs'}{$class} ) . "\n";

	my ( $first, $second )
		= sort { $explanation->{'scores'}{$b} <=> $explanation->{'scores'}{$a} } keys %{ $explanation->{'scores'} };
	if ( !defined($second) ) {
		return;
	}

	my %pull;
	foreach my $token ( keys %{ $explanation->{'tokens'} } ) {
		my $contribs = $explanation->{'tokens'}{$token}{'contributions'};
		$pull{$token} = ( $contribs->{$first} - $contribs->{$second} ) * $explanation->{'tokens'}{$token}{'count'};
	}
	foreach my $token ( sort { $pull{$b} <=> $pull{$a} } keys %pull ) {
		my $towards = $pull{$token} > 0 ? $first : $second;
		print '    ' . $token . ' pushed towards ' . $towards . ' by ' . sprintf( '%.3f', abs( $pull{$token} ) ) . "\n";
	}
} ## end sub execute

1;

t/11-app.t  view on Meta::CPAN

##
## train
##

my $result = test_app( $app => [ 'train', '-m', $model, '-c', 'spam', 'buy', 'cheap', 'pills', 'now' ] );
is( $result->error, undef, 'train runs' );
like( $result->stdout, qr/Trained "spam", 1 total documents/, 'train reports what it did' );
ok( -f $model, 'train creates the model file' );

$result = test_app( $app => [ 'train', '-m', $model, '-c', 'ham', 'meeting', 'at', 'noon', 'tomorrow' ] );
is( $result->error, undef, 'training a second class works' );
like( $result->stdout, qr/2 total documents/, 'total documents incremented' );

# creation only options are rejected on an existing model
$result = test_app( $app => [ 'train', '-m', $model, '-c', 'spam', '--ngrams', '2', 'foo' ] );
like( $result->error, qr/only be used when creating/, 'creation options rejected on a existing model' );

# missing -c
$result = test_app( $app => [ 'train', '-m', $model, 'foo' ] );
like( $result->error, qr/-c has not been specified/, 'train without -c errors' );