#!/usr/bin/perl


#
# Usage: nphp-eval.pl <run_file> <qrels>
#

# (this script was called 'MRR-rank.pl' in TREC 11)

# Compute the mean reciprocal rank for runs for TREC 2005 Enterprise
# Track known-item finding task.
# The arguments to the script are:
#      run_file: the name of the run file to be evaluated
#      qrels:    the name of the qrels file to use when evaluating

# Use the simple, brute-force approach---read judgment file into
# memory and then read the run file.  Locate targets for each
# question, find first (if any) correct answer and compute score.
# Finally report total number topics with no named page found and mean
# reciprocal.

$#ARGV == 1 || die "Usage: nphp-eval.pl run_file qrels\n";
$run_file = $ARGV[0];
$qrels = $ARGV[1];

if ( (! -e $run_file) || (! open RUN, "<$run_file") ) {
    die "Can't find/open run file `$run_file': $!\n";
}

# read in judgment file
if ( (! -e $qrels) || (! open QRELS, "<$qrels") ) {
    die "Can't find/open homepages file `$qrels': $!\n";
}
while ($line = <QRELS>) {
    chomp $line;
    ($t,$z,$docno,$judgment) = split " ",$line, 4;
    $t =~ s/^KI//;
    $judgments{$t}{$docno} = $judgment;
}
close QRELS || die "Close of homepages file failed: $!\n";

$num_qs = scalar(keys %judgments);
%retrieved = ();

while ($line = <RUN>) {
    chomp $line;
    ($t, $q0, $docno, $given_rank, $sim, $xtag) = split " ", $line, 6;
    $t =~ s/^KI//;

    next unless exists $judgments{$t};
    if (exists $retrieved{$t}{$given_rank}) {
	die "Run $tag, topic $t: Two documents ($docno and $retrieved{$given_rank}) both have rank $given_rank\n";
    }
    
    $retrieved{$t}{$given_rank} = $docno;
}
close RUN;
    
$notfound = 0;
$sum = 0;
$top10 = 0;
%tranks = ();

for my $topic (sort { $a <=> $b } keys %judgments) {
    $tranks{$topic} = score($topic, $retrieved{$topic});

    if ($tranks{$topic} == 0) {
	$notfound++;
	printf "Topic %3d: No target page found.\n", $topic;
	
    } else {
	my $recip = 1.0 / $tranks{$topic};
	$sum += $recip;
	if ($tranks{$topic} <= 10) {
	    $top10++;
	}
	printf "Topic %3d: Target page found at rank %d\n",
	    $topic, $tranks{$topic};
    }
}

$ave  = $sum / $num_qs;
printf "\nAverage reciprocal rank over $num_qs topics: %.3f\n", $ave;
printf "Number of topics for which target page found in top 10:  %d (%.1f%%)\n",
    $top10, ($top10/$num_qs)*100;
printf "Number of topics for which no target was found:  %d (%.1f%%)\n",
    $notfound, ($notfound/$num_qs)*100;

sub numerically { $a <=> $b }

sub score {
    my ($topic, $retr) = @_;

    my $rank = 1;
    my $trank = 0;
    for my $scr (sort numerically keys %$retr) {
	if ($judgments{$topic}{$retr->{$scr}} == 1) {
	    $trank = $rank;
	    last;
	}
	$rank++;
    }
    
    return $trank;
}