File Coverage

blib/lib/Algorithm/Classifier/NaiveBayes/App/Command/prune.pm
Criterion Covered Total %
statement 28 32 87.5
branch 4 6 66.6
condition 2 3 66.6
subroutine 8 10 80.0
pod 3 5 60.0
total 45 56 80.3


line stmt bran cond sub pod time code
1             package Algorithm::Classifier::NaiveBayes::App::Command::prune;
2              
3 1     1   673 use 5.006;
  1         3  
4 1     1   5 use strict;
  1         2  
  1         32  
5 1     1   4 use warnings;
  1         1  
  1         36  
6 1     1   4 use Algorithm::Classifier::NaiveBayes ();
  1         2  
  1         30  
7 1     1   3 use Algorithm::Classifier::NaiveBayes::App -command;
  1         1  
  1         8  
8              
9             sub options {
10 2     2 0 13 return ( [ 'm=s', 'Model JSON file path/name.', { 'default' => 'nb_model.json', 'completion' => 'files' } ], );
11             }
12              
13 0     0 1 0 sub abstract { 'Prune rarely seen tokens from a saved model' }
14              
15             sub description {
16 0     0 1 0 return 'Prune all tokens trained fewer than the specified number of times.
17              
18             The count is totaled across all classes. The min count is taken from
19             the remaining args.
20              
21             # remove all tokens only trained once
22             nb_tool prune -m model.json 2
23             ';
24             } ## end sub description
25              
26             sub validate {
27 2     2 0 4 my ( $self, $opt, $args ) = @_;
28              
29 2 50       45 if ( !-f $opt->{'m'} ) {
30 0         0 $self->usage_error( '-m, "' . $opt->{'m'} . '", is not a file or does not exist' );
31             }
32              
33 2 50       6 if ( !defined( $args->[0] ) ) {
34 0         0 $self->usage_error('No min count specified');
35             }
36 2 100 66     12 if ( $args->[0] !~ /\A\d+\z/ || $args->[0] < 1 ) {
37 1         11 $self->usage_error( 'The min count, "' . $args->[0] . '", is not a whole number greater than 0' );
38             }
39              
40 1         3 return 1;
41             } ## end sub validate
42              
43             sub execute {
44 1     1 1 4 my ( $self, $opt, $args ) = @_;
45              
46 1         8 my $nb = Algorithm::Classifier::NaiveBayes->new;
47 1         4 $nb->load( $opt->{'m'} );
48              
49 1         18 my $pruned = $nb->prune( $args->[0] );
50 1         4 $nb->save( $opt->{'m'} );
51              
52             print 'Pruned '
53             . $pruned
54             . ' tokens, '
55 1         2 . scalar( keys %{ $nb->{'model'}{'tokens'} } )
  1         9  
56             . ' remaining in the vocabulary' . "\n";
57             } ## end sub execute
58              
59             1;