File Coverage

blib/lib/RePrec/Collection.pm

Criterion	Covered	Total	%
statement	9	46	19.5
branch	0	20	0.0
condition	0	6	0.0
subroutine	3	8	37.5
pod	4	4	100.0
total	16	84	19.0

######################### -*- Mode: Perl -*- #########################
##
## File          : $RCSfile: Collection.pm,v $
##
## Author        : Norbert Goevert
## Created On    : Thu Feb  6 17:43:59 1997
## Last Modified : Time-stamp: <2000-11-23 17:40:56 goevert>
##
## Description   :
##
## $Id: Collection.pm,v 1.28 2003/06/13 12:29:30 goevert Exp $
##
######################################################################


use strict;


## ###################################################################
## package RePrec::Collection
## ###################################################################

package RePrec::Collection;


use Carp;

use vars qw($VERSION);

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


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

sub new {

  my $proto = shift;
  my $class = ref($proto) || $proto;
  my %params = @_;

  my $self  = {};

  bless $self => $class;

  $self->_init(%params);

  return $self;
}


sub get_numdocs {

  my $self = shift;
  return $self->{numdocs};
}


sub relevant {

  my $self = shift;
  my($qid, $docid) = @_;

  $self->{qrels}->{$qid}->{$docid};
}


sub get_numrels {

  my $self = shift;
  my $qid = shift;

  return 0 unless defined $self->{numrels}->{$qid};

  $self->{numrels}->{$qid};
}


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

sub _init {

  my $self = shift;
  my %parms = @_;

  my $file   = $parms{file};
  my $sep    = defined $parms{separator} ? $parms{separator} : ' +';
  my $ignore = defined $parms{ignore}    ? $parms{ignore}    : undef;
  my $qid    = defined $parms{qid}       ? $parms{qid}       : 0;
  my $docid  = defined $parms{docid}     ? $parms{docid}     : 1;
  my $judge  = defined $parms{judge}     ? $parms{judge}     : 2;
  $self->{numdocs} = $parms{numdocs}
    or croak "`Number of documents in collection' parameter missing\n";

  my $QRELS = IO::File->new($file)
    or croak "Couldn't read open file `$file': $!\n";

  my(%qrels, %numrels);
  local $_;
  while (<$QRELS>) {
    chomp;
    next if defined $ignore and /$ignore/;
    my($_qid, $_docid, $_judge) = (split /$sep/)[$qid, $docid, $judge];
    if ($_judge == 1) {
      $qrels{$_qid}->{$_docid} = 1;
      $numrels{$_qid}++;
    }
  }

  $self->{qrels}   = \%qrels;
  $self->{numrels} = \%numrels;
}


1;
__END__