view release on metacpan or  search on metacpan

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

    # 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;
    $self->{context_size} = $context_size;
    return;
}

#pod =head2 C<statistical_summary>
#pod
#pod Returns a scalar reference (string) containing a statistical summary
#pod of the classification results. The summary includes all possible
#pod predicted classes with their scores and percentage scores and the
#pod total score for all classes. Whether the predicted class
#pod is correct/incorrect/a tie of some sort is also included, if the
#pod test item had a known class.
#pod
#pod =cut
sub statistical_summary {
    my ($self) = @_;
    my %scores = %{$self->scores};
    my $total_points = $self->total_points;

    # Make a table with information about predictions for different
    # classes. Each row contains a class name, the score,
    # and the percentage predicted.
    my @rows;
    for my $class (sort keys %scores){
        push @rows, [ $class, $scores{$class},
            sprintf($percentage_format,
                100 * $scores{$class} / $total_points) ];
    }
    # add a Total row
    push @rows, [ 'Total', $total_points ];

    my @table = _make_table(['Class', 'Score', 'Percentage'],
        \@rows);
    # copy the rule from the first row into the second to last row
    # to separate the Total row
    splice(@table, $#table - 1, 0, $table[0]);

    my $info = "Statistical Summary\n";
    $info .= join '', @table;
    # the predicted class (the one with the highest score)
    # and the result (correct/incorrect/tie).
    if ( defined (my $expected = $self->test_item->class) ) {
        $info .= "Expected class: $expected\n";
        my $result = $self->result;
        if ( $result eq 'correct') {
            $info .= "Correct class predicted.\n";
        }elsif($result eq 'tie'){
            $info .= "Prediction is a tie.\n";
        }else {
            $info .= "Incorrect class predicted.\n";
        }
    }else{
        $info .= "Expected class unknown\n";
    }
    return \$info;
}

#TODO: the keys for this set don't seem to make any sense.
sub analogical_set {
    my ($self) = @_;
    if(!exists $self->{_analogical_set}){
        $self->_calculate_analogical_set;
    }
    # make a safe copy
    my %set = %{$self->{_analogical_set}};
    return \%set;
}

#pod =head2 C<analogical_set_summary>
#pod
#pod Returns a scalar reference (string) containing the analogical set,
#pod meaning all items that contributed to the predicted class, along
#pod with the amount contributed by each item (score and
#pod percentage overall). Items are ordered by appearance in the data
#pod set.
#pod
#pod =cut
sub analogical_set_summary {
    my ($self) = @_;
    my $set = $self->analogical_set;
    my $total_points = $self->total_points;

    # Make a table for the analogical set. Each row contains an
    # item with its class, comment, score, and the percentage
    # of total score contributed.
    my @rows;
    foreach my $id (sort keys %$set){
        my $entry = $set->{$id};
        my $score = $entry->{score};
        push @rows, [
            $entry->{item}->class,
            $entry->{item}->comment,
            $score,
            sprintf($percentage_format, 100 * $score / $total_points)