#!/usr/bin/perl -w
# Blog post evaluation tool for Top Stories Identification Task, TREC Blog Track 2010
# By Craig Macdonald, University of Glasgow, version 0.1
# Installation: Copy to folder. Update path of ndeval (1.3 or later)
# Usage: ./ndeval_blog2010_nbprt.pl  10.top-stories.blog.qrels run.res

#set this to the path of ndeval, version 1.3 or above. Ie, it must support the -c option,
#to average over all "topics" in the qrels
my $NDEVAL = "./ndeval";

#dont alter anything below this line, unless you have fully read and understand this script
use strict;
use File::Temp qw/ :POSIX  tempfile /;
use File::Basename;

#set this to 1 is ndeval doesnt support string "topic" ids
my $MAP_HEADLINES_TO_IDS =1;
#set this to 1 for more output
my $DEBUG = 0;

die usage() unless @ARGV ==2;

my ($REAL_BP_QRELS, $REAL_RUN) = @ARGV;
#what should we call this run?
my $runName = basename($REAL_RUN);
$runName =~ s/.gz$//;
$runName =~ s/.res$//;

#if MAP_HEADLINES_TO_IDS is set, then we need to map headlineids to numeric forms, and back again
my %story2id;
my %id2story;
my $nextid = 0;

#this is the list of relevant headlines, from the first qrels file
my %rel_headlines;
#this is the list of relevant headlines for which blog post judging was performed, as from the 2nd qrels file
my %headlines_with_posts_judged;

###############################
#1. create qrels file for ndeval, mapping headlines to numeric form if necessary.
#   also populate %headlines_with_posts_judged
###############################
my ($new_qrels_fh, $new_qrels_filename) = tempfile();
open(R_QRELS, "$REAL_BP_QRELS") or die "Couldn't open qrels file $REAL_BP_QRELS : $!\n";
while(<R_QRELS>)
{
	chomp;
	my ($story, $aspect, $docno, $rel) = split / /, $_;
	$headlines_with_posts_judged{$story} = 1;
	my $id;
	if ($MAP_HEADLINES_TO_IDS)
	{
		if (exists $story2id{$story})
		{
			$id = $story2id{$story};
		}
		else
		{
			$id = $nextid++;
			$story2id{$story} = $id;
			$id2story{$id} = $story;
		}
	}
	else
	{
		$id = $story;
	}
	print $new_qrels_fh "$id $aspect $docno $rel\n";
}
close R_QRELS;
close $new_qrels_fh;
warn "Made mappings for ".(scalar keys %story2id). " headlines into new qrels file $new_qrels_filename" if $DEBUG and $MAP_HEADLINES_TO_IDS;

###############################
#2. create a temporary run file that ndeval understands, if $MAP_HEADLINES_TO_IDS
###############################

my ($new_run_fh, $new_run_filename) = tempfile();
if ("$REAL_RUN" =~ /.gz$/)
{
	open(R_RUN, "gzip -dc $REAL_RUN|") or die "Couldn't gz open results file $REAL_RUN : $!\n";
}
else
{
	open(R_RUN, "$REAL_RUN") or die "Couldn't open results file $REAL_RUN : $!\n";
}
my %done;
my ($tsid, $headline, $hrank, $hscore, $run);
while(<R_RUN>)
{
   	#TS10b-NUM-before Q0 BLOG08-20080426-000333190 1 9.8 runtag
	#TS10b-NUM-before Q0 BLOG08-20080426-000532120 2 9.0 runtag
	#...
	#TS10b-NUM-day Q0 BLOG08-20080427-010333190 1 9.9 runtag
	#...
	#TS10b-NUM-week Q0 BLOG08-20080430-11111111 1 4.2 runtag
	#...

    chomp;
   	next if ($_ eq '');
	my ($story, undef, $docno, $rank, $score, $tag) = split  /\s+/, $_;
	$story = $story2id{$story} if $MAP_HEADLINES_TO_IDS;
	die unless defined  $story;
	print $new_run_fh "$story Q0 $docno $rank $score $tag\n";
}
close R_RUN;
close $new_run_fh;

###############################
#4. run ndeval on the new qrels and run files, and then
#   renumber numeric topics ids back to string form in
#   the output, as well as replace run name.
###############################
open(NDEVAL, "$NDEVAL -c $new_qrels_filename $new_run_filename |") or die "Couldnt open fork : $!\n";
while(<NDEVAL>)
{
	chomp;
	if ($_ =~ /^runid/ or $_ =~ /amean/)
	{
		print "$_\n";
	}
	else
	{
		my @parts = split /,/, $_;
		$parts[0] = $runName;
		$parts[1] = $id2story{$parts[1]} if $MAP_HEADLINES_TO_IDS;
		print join ',', @parts;
		print "\n";
	}
}
close NDEVAL;
#delete any leftover temporary files
unless ($DEBUG)
{
	unlink $new_qrels_filename;
	unlink $new_run_filename;
}

sub usage
{
	return "Usage: $0 10.top-stories.blog.qrels run.res\n";
}

sub formt
{
    my $headline = shift;
	if ( $MAP_HEADLINES_TO_IDS)
	{
		die "No headline mapping for $headline found" unless exists $story2id{$headline};
    	return $story2id{$headline};
	}
	return $headline;
}

