File Coverage

blib/lib/RePrec/Searchresult.pm

Criterion	Covered	Total	%
statement	6	80	7.5
branch	0	38	0.0
condition	0	12	0.0
subroutine	2	8	25.0
pod	4	5	80.0
total	12	143	8.3

######################### -*- Mode: Perl -*- #########################
##
## File          : $RCSfile: Searchresult.pm,v $
##
## Author        : Norbert Goevert
## Created On    : Mon Nov  9 16:54:39 1998
## Last Modified : Time-stamp: <2000-12-20 16:49:12 goevert>
##
## Description   :
##
## $Id: Searchresult.pm,v 1.28 2003/06/13 12:29:30 goevert Exp $
##
######################################################################


use strict;


## ###################################################################
## package RePrec::Searchresult
## ###################################################################

package RePrec::Searchresult;


use Carp;


our $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 $self  = {};
  my($qid, $results, @parms) = @_;

  bless $self => $class;

  if (defined $results) {
    if (ref $results eq 'ARRAY') {
      foreach (@{$results}) {
        croak "Wrong type of search result element"
          unless ref $_ eq 'ARRAY' and @$_ == 2;
      }
      $self->{results} = $results;
    } elsif (ref $results) {
      croak "Wrong reference type for results parameter";
    } else {
      $self->_init($results, @parms);
    }
  } else {
    croak "filename or array with searchresults needed";
  }

  $self->{qid} = $qid;

  return $self;
}


sub distribution {

  my $self = shift;
  my $judgements = shift;

  return $self->{distribution} if $self->{distribution};

  croak "wrong type of judgements parameter"
    unless ref $judgements and $judgements->isa('RePrec::Collection');

  $self->{numdocs} = $judgements->get_numdocs;
  $self->{rels} = 0;
  $self->{nrels} = 0;

  my @distribution;
  my($rels,     $nrels)     = (0, 0);
  my $rank;
  foreach (@{$self->{results}}) {
    $rank = $_->[0] unless $rank;
    if ($rank != $_->[0]) {
      push @distribution, [ $rels, $nrels ];
      $rank = $_->[0];
      ($rels, $nrels) = (0, 0);
    }
    if ($judgements->relevant($self->{qid}, $_->[1])) {
      $rels++;
      $self->{rels}++;
    } else {
      $nrels++;
      $self->{nrels}++;
    }
  }
  push @distribution, [ $rels, $nrels ];

  # create entry for very last rank if necessary
  if ($self->{numdocs} > $self->{rels} + $self->{nrels}) {
    my $rels_tot = $judgements->get_numrels($self->{qid});
    my $nrels_tot = $self->{numdocs} - $rels_tot;
    push @distribution, [ $rels_tot  - $self->{rels},
                          $nrels_tot - $self->{nrels}
                        ];
  }

  $self->{distribution} = \@distribution;
}


sub numdocs {

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


sub rels {

  my $self = shift;
  $self->{rels};
}


sub nrels {

  my $self = shift;
  $self->{nrels};
}


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

sub _init {

  my $self = shift;
  my $file = shift;
  my %parm = @_;

  my $sep    = defined $parm{separator} ? $parm{separator} : '\s+';
  my $ignore = defined $parm{ignore}    ? $parm{ignore}    : undef;
  my $docid  = defined $parm{docid}     ? $parm{docid}     : 0;
  my($rate, $rank) = ( 1, undef );
  if (defined $parm{rsv}) {
    $rate = $parm{rsv};
  } elsif (defined $parm{rank}) {
    $rate = $parm{rank};
    $rank = 1;
  }

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

  my @results;
  local $_;
  while (<$fh>) {
    chomp;
    next if defined $ignore and /$ignore/;
    my($_rate, $_docid) = (split /$sep/)[$rate, $docid];
    $_rate = - $_rate if $rank; # convert rank into RSV if necessary
    push @results, [ $_rate, $_docid ];
  }

  if ($parm{sorted}) {
    $self->{results} = \@results;
  } else {
    $self->{results} = [ sort { $b->[0] <=> $a->[0] } @results ];
  }
}


1;
__END__