#!/usr/bin/perl -w

use strict;

# Check a TREC 2005 enterprise track submission for various errors.
# Usage: check_enterprise.pl task resultsfile
#     where task is one of "discussion", "knownitem", or "expert"

# The discussion and knownitem tasks are in trec_eval format.
# Expert task is unknown as of this version.
# Messages regarding submission are printed to an error log


# For the discussion and knownitem tasks, the result file is in the form
#     topic_num Q0 docno rank sim tag
# Script uses UNIX sort routine to ensure input is sorted by increasing
# topic number and decreasing sim.  If run on non-unix system,
# use alternate open command, but make sure input file is sorted
# Note that line numbers in the error output refer to the SORTED file!
# The errors checked for for these tasks include
#      * extra fields
#      * multiple run tags
#      * missing or extraneous topics
#      * invalid retrieved documents
#      * duplicate retrieved documents in a single topic
#      * too many documents retrieved for a topic
#      * fewer than maximum allowed retrieved for a topic (warning)

# Change this variable to the directory where the error log should be put
my $errlog_dir = ".";

# If more than 25 errors, then stop processing; something drastically
# wrong with the file.
my $MAX_ERRORS = 25; 


my $task;               # task run is submitted to (argument)
my $results_file;       # results file (argument)
my $errlog;             # name of error log file
my ($num_errors, $line_num);
my ($last_i, $i);

my $usage = "Usage: $0 task resultsfile\n\ttask is one of 'discussion', 'knownitem', or 'expert'\n";

$task = shift @ARGV or die $usage;
die $usage unless ($task eq "discussion" || 
		   $task eq "knownitem" ||
		   $task eq "expert");

$results_file = shift @ARGV or die $usage;

$last_i = -1;
while ( ($i=index($results_file,"/",$last_i+1)) > -1) {
    $last_i = $i;
}
$errlog = $errlog_dir . "/" . substr($results_file,$last_i+1) . ".errlog";
open ERRLOG, ">$errlog" ||
	die "Cannot open error log for writing\n";


$num_errors = 0;
$line_num = 0;

# since the results differ so much, use different check routines
if ($task eq "expert") {
    die "Sorry, expert checks not written yet.\n";
}
elsif ($task eq "discussion" or $task eq "knownitem") {
    check_adhoc_task();
}

print ERRLOG "Finished processing $results_file\n";
close ERRLOG || die "Close failed for error log $errlog: $!\n";
print "Finished processing $results_file\n";

if ($num_errors) { exit 255; }
exit 0;





# process an adhoc run
sub check_adhoc_task {

    my $MINQ;
    my $MAXQ;
    my $MAX_RET;
    my $prefix;

    my %topic_docnos;	    # hash of docs retrieved for current topic
    my ($topic_string,$q0,$docno,$rank,$sim,$tag,$rest);
    my @num_ret;	    # number of docs retrieved per topic
    my $line;               # line from input file;
    my ($topic, $old_topic, $t);
    my $run_id;
    my $found;
    my $q0warn;

    if ($task eq "discussion") {
	$MINQ = 1;
	$MAXQ = 60;
	$MAX_RET = 1000;
	$prefix = "DS";

    } elsif ($task eq "knownitem") {
	$MINQ = 26;
	$MAXQ = 150;
	$MAX_RET = 100;
	$prefix = "KI";
    }

    for ($t=$MINQ; $t<=$MAXQ; $t++) {
        $num_ret[$t] = 0;
    }

    # Sort the input file by topic_num, sim and read result
    # ASSUMES UNIX; FOR non-unix, comment out this open, and use
    # alternate open --- make sure file is sorted!
    open RESULTS, "nl -s' ' -nln -ba -fn $results_file | sort +1 -2 +5 -6gr |"
	or die "Unable to open (or sort) results file $results_file: $!\n";
    #open RESULTS, "<$results_file" ||
    #	die "Unable to open results file $results_file: $!\n";



    $q0warn = 0;
    $old_topic = "-1";
    $run_id = "";
    while ($line = <RESULTS>) {
        chomp $line;
        next if ($line =~ /^\s*$/);

	undef $tag;
	my @fields = split " ", $line;
	$line_num++ unless scalar(@fields) == 7;

	if (scalar(@fields) == 7) {
	    ($line_num,$topic_string,$q0,$docno,$rank,$sim,$tag) = @fields;
	} elsif (scalar(@fields) == 6) {
	    # Input was sorted outside the check script
	    ($topic_string,$q0,$docno,$rank,$sim,$tag) = @fields;
	} else  {
	    &error("Too many fields");
	    die "\n";
	}

        # make sure runtag is ok
        if (! $run_id) { 	# first line --- remember tag 
	    $run_id = $tag;
	    if ($run_id !~ /^[A-Za-z0-9]{1,12}$/) {
	        &error("Run tag `$run_id' is malformed");
	        next;
   	    }
        }
        else {			# otherwise just make sure one tag used
	    if ($tag ne $run_id) {
	        &error("Run tag inconsistent (`$tag' and `$run_id')");
	        next;
	    }
        }

        # get topic number
        if ($topic_string ne $old_topic) {
	    $old_topic = $topic_string;
	    undef %topic_docnos;
            $topic_string =~ s/^$prefix(0)*//o;
	    $topic = $topic_string;
	    if ($topic < $MINQ || $topic > $MAXQ) {
                &error("Unknown topic ($topic_string)");
                $topic = 0;
                next;
            }  
        }


        # make sure second field is "Q0"
        if ($q0 ne "Q0" && ! $q0warn) {
            $q0warn = 1;
            &error("Field 2 is `$q0' not `Q0'");
        }


        # approximate check for correct docno
        if ($docno !~ /^lists-\d{3}-\d+$/) {	# invalid DOCNO
            &error("Unknown document `$docno'");
	    next;
        }
        if (exists $topic_docnos{$docno}) {
            &error("Document `$docno' retrieved more than once for topic $topic_string");
            next;
        }
        $topic_docnos{$docno} = $topic;

        # remove leading 0's from rank (but keep final 0!)
	$rank =~ s/^0*//;
        if (! $rank) {
            $rank = "0";
        }

        $num_ret[$topic]++;
    }



    # Do global checks:
    #   error if some topic has no (or too many) documents retrieved for it
    #   warn if too few documents retrieved for a topic
    for ($t=$MINQ; $t<=$MAXQ; $t++) { 
        if ($num_ret[$t] == 0) {
            &error("No documents retrieved for topic $prefix$t");
        }
        elsif ($num_ret[$t] > $MAX_RET) {
            &error("Too many documents ($num_ret[$t]) retrieved for topic $prefix$t");
        }
        elsif ($num_ret[$t] < $MAX_RET) {
	    print ERRLOG "$0 of $results_file:  WARNING: only $num_ret[$t] documents retrieved for topic $prefix$t\n"
        }
    }
}


# print error message, keeping track of total number of errors
# line numbers refer to SORTED file since that is the actual input file
sub error {
   my $msg_string = pop(@_);

    print ERRLOG 
    "$0 of $results_file: Error on line $line_num --- $msg_string\n";

    $num_errors++;
    if ($num_errors > $MAX_ERRORS) {
        print ERRLOG "$0 of $results_file: Quit. Too many errors!\n";
        close ERRLOG ||
		die "Close failed for error log $errlog: $!\n";
	exit 255;
    }
}
