view release on metacpan or  search on metacpan

lib/Algorithm/AM/Result.pm  view on Meta::CPAN

        my $normalized = {};
        for my $class (keys %$scores){
            $normalized->{$class} = $scores->{$class} / $total_points
        }
        return $normalized;
    },
};
use Carp 'croak';
use Algorithm::AM::BigInt 'bigcmp';

# For printing percentages in reports
my $percentage_format = '%.3f';

#pod =head1 REPORT METHODS
#pod
#pod The methods below return human eye-friendly reports about the
#pod classification. The return value is a reference, so it must be
#pod dereferenced for printing like so:
#pod
#pod  print ${ $result->statistical_summary };
#pod
#pod =head2 C<config_info>
#pod
#pod Returns a scalar (string) ref containing information about the
#pod configuration at the time of classification. Information from the
#pod following accessors is included:
#pod
#pod     exclude_nulls
#pod     given_excluded
#pod     cardinality
#pod     test_in_train
#pod     test_item
#pod     count_method
#pod
#pod =cut
sub config_info {
    my ($self) = @_;
    my @headers = ('Option', 'Setting');
    my @rows = (
        [ "Given context", (join ' ', @{$self->test_item->features}) .
            ', ' . $self->test_item->comment],
        [ "Nulls", ($self->exclude_nulls ? 'exclude' : 'include')],
        [ "Gang",  $self->count_method],
        [ "Test item in training set", ($self->test_in_train ? 'yes' : 'no')],
        [ "Test item excluded", ($self->given_excluded ? 'yes' : 'no')],
        [ "Size of training set", $self->training_set->size ],
        [ "Number of active features", $self->cardinality ],
    );
    my @table = _make_table(\@headers, \@rows);
    my $info = join '', @table;
    return \$info;
}

# input several variables from AM's guts (sum, pointers,
# itemcontextchainhead and itemcontextchain). Calculate the
# prediction statistics, and
# store information needed for computing analogical sets.
# Set result to tie/correct/incorrect and also is_tie if
# expected class is provided, and high_score, scores, winners, and
# total_points.
sub _process_stats {
    my ($self, $sum, $pointers,
        $itemcontextchainhead, $itemcontextchain, $context_to_class,
        $raw_gang, $active_feats, $context_size) = @_;
    my $total_points = $pointers->{grand_total};
    my $max = '';
    my @winners;
    my %scores;

    # iterate all possible classes and store the ones that have a
    # non-zero score. Store the high-scorers, as well.
    # 1) find which one(s) has the highest score (the prediction) and
    # 2) print out the ones with scores (probability of prediction)
    for my $class_index (1 .. $self->training_set->num_classes) {
        my $class_score;
        # skip classes with no score
        next unless $class_score = $sum->[$class_index];

        my $class = $self->training_set->_class_for_index($class_index);
        $scores{$class} = $class_score;

        # check if the class has the highest score, or ties for it
        do {
            my $cmp = bigcmp($class_score, $max);
            if ($cmp > 0){
                @winners = ($class);
                $max = $class_score;
            }elsif($cmp == 0){
                push @winners, $class;
            }
        };
    }

    # set result to tie/correct/incorrect after comparing
    # expected/actual class labels. Only do this if the expected
    # class label is known.
    if(my $expected = $self->test_item->class){
        if(exists $scores{$expected} &&
                bigcmp($scores{$expected}, $max) == 0){
            if(@winners > 1){
                $self->result('tie');
            }else{
                $self->result('correct');
            }
        }else{
            $self->result('incorrect');
        }
    }
    if(@winners > 1){
        $self->is_tie(1);
    }
    $self->high_score($max);
    $self->scores(\%scores);
    $self->winners(\@winners);
    $self->total_points($total_points);
    $self->{pointers} = $pointers;
    $self->{itemcontextchainhead} = $itemcontextchainhead;
    $self->{itemcontextchain} = $itemcontextchain;
    $self->{context_to_class} = $context_to_class;
    $self->{raw_gang} = $raw_gang;
    $self->{active_feats} = $active_feats;