#!/usr/bin/perl


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

# Compute the mean reciprocal rank for runs for TREC 2005 Terabyte Track 
# named-page finding task.
# The arguments to the script are:
#      run_list:   the name of the file containing the tags of the runs to
#		   be evaluated, one tag per line (can be created from
#		   the runs table)
#      qrels: the name of the qrels file to use when evaluating

# Use the simple, brute-force approach---read judgment file into memory
# and sort submission file by topic-id, rank.  Read in 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.

# Compute score for each topic and mean over all topics.

$#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;
    $judgments{$t}{$docno} = $judgment;
}
close QRELS || die "Close of homepages file failed: $!\n";

$oldt = -1;
$sum = 0;
$notfound = 0;
$top10 = 0;
$num_qs = 0;
%retrieved = ();
while ($line = <RUN>) {
    chomp $line;
    ($t, $q0, $docno, $given_rank, $sim, $xtag) = split " ", $line, 6;
    
    next unless exists $judgments{$t};
    
    if ($t != $oldt) {
	# print oldt's score and add to running sum for average
	# re-initialize for current topic
	
	if ($oldt != -1) { # i.e., not very first topics
	    
	    $trank = score($oldt, \%retrieved);
	    if ($trank != 0) { # had answer 
		$recip  = 1 / $trank;
		printf "Topic %3d: Named page found at rank %d\n",
		    $oldt, $trank; 
		$sum += $recip;
		if ($trank <= 10) {
		    $top10++;
		}
	    }
	    else { #no answer 
		printf "Topic %3d: No correct named page found.\n", $oldt;
		$notfound++;
	    }
	}
	$trank = 0;
	%retrieved = ();
	$num_qs++;
	$oldt = $t;
    }
    
    if (exists $retrieved{$given_rank}) {
	die "Run $tag, topic $t: Two documents ($docno and $retrieved{$given_rank}) both have rank $given_rank\n";
    }
    
    $retrieved{$given_rank} = $docno;
}

close(RUN);

if ($t != 0) { # i.e., submission file not empty
    $trank = score($t, \%retrieved);
    if ($trank != 0) { # last q had answer 
	$recip  = 1 / $trank;
	printf "Topic %3d: Named page found at rank %d.\n",
	    $oldt, $trank;
	$sum += $recip;
	if ($trank <= 10) {
	    $top10++;
	}
    }
    else { #no answer 
	printf "Topic %3d: No correct named page found.\n", $oldt;
	$notfound++;
    }
}

$ave  = $sum / $num_qs;
printf "\nAverage reciprocal rank over $num_qs topics: %.3f\n", $ave;
printf "Number of topics for which named page found in top 10:  %d (%.1f%%)\n",
    $top10, ($top10/$num_qs)*100;
printf "Number of topics for which no named page 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;
}