The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
###*###################### -*- Mode: Perl -*- #########################
##
## File          : $RCSfile: Raw.pm,v $
##
## Author        : Norbert Gövert
## Created On    : Mon Oct 30 11:21:58 2000
## Last Modified : Time-stamp: <2000-11-09 18:28:11 goevert>
##
## Description   : 
##
## $Id: Raw.pm,v 1.6 2003/06/13 12:29:30 goevert Exp $
##
######################################################################


use strict;


=pod #---------------------------------------------------------------#

=head1 NAME

RePrec::Raw - compute precision values

=head1 SYNOPSIS

See RePrec(3).

=head1 DESCRIPTION

Computation of raw precision values at simple recall points. Precision
is not uniquely defined in the case of ranks which don't have relevant
documents. Therefore it migth happen that for a given recaqll point
more than one precision value is returned. Precision is only defined
for simple recall points.

=head1 METHODS

See RePrec(3).

=cut #---------------------------------------------------------------#


package RePrec::Raw;


use base qw(RePrec);


our $VERSION;
'$Name: release_0_32 $ 0_0' =~ /(\d+)[-_](\d+)/; $VERSION = sprintf '%d.%03d', $1, $2;


## public ############################################################

sub precision {

  my $self = shift;
  my @recall = @_;

  my @result;

  foreach my $recall (@recall) {

    return undef unless defined $recall and $recall >= 0 and $recall <= 1;

    # relevant documents found up to recall point $recall
    my $rels = $recall * $self->{rels};

    # we only can compute the raw precision for simple recall points
    return undef unless $rels == int $rels;

    # which ranks do we explore?
    my @ranks;
    if (exists $self->{rels_rank}->[$rels]) {
      # there might be more than one precision value on a single recall point
      # (in the case that a rank does not contain any relevant document)
      @ranks = $self->{rels_rank}->[$rels - 1] .. $self->{rels_rank}->[$rels] - 1;
    } else {
      @ranks = $self->{rels_rank}->[$rels - 1];
    }

    foreach (@ranks) {
      my $total = $self->{rank_rels_nrels}->[$_]->[0] + $self->{rank_rels_nrels}->[$_]->[1];
      push @result, [ $recall, $rels / $total ];
    }
  }

  @result;
}


sub precision_rank {

  my $self = shift;

  my @result;
  foreach (@{$self->{rank_rels_nrels}}) {
    my $total = $_->[0] + $_->[1];
    my $recall = $_->[0] / $self->{rels};
    push @result, [ $recall, $_->[0] / $total ];
  }

  @result;
}


## private ###########################################################


=pod #---------------------------------------------------------------#

=head1 BUGS

Yes. Please let me know!

=head1 SEE ALSO

RePrec(3),
perl(1).

=head1 AUTHOR

Norbert GE<ouml>vert E<lt>F<goevert@ls6.cs.uni-dortmund.de>E<gt>

=cut #---------------------------------------------------------------#


1;
__END__