view release on metacpan or  search on metacpan

lib/RePrec/Searchresult.pm  view on Meta::CPAN

######################### -*- 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});