#!/usr/bin/perl -w

use strict;

# Check a TAC 2011 KBP Track full temporal slot-filling task submission for various common errors, including:
#      * invalid run tag (should be a concatenation of your TAC 2011 team ID and the run number (1-3)
#      * multiple run tags
#      * invalid query id or slot name
#      * missing value for a question (at least one response required per question)
#      * answer from an invalid document (approximate check)
#      * more than one response for a question if column 3 is NIL
#      * more than one response for a question+answer if column 3 is V
#      * more than four responses for a question+answer when column 3 is T1, T2, T3, or T4
#           (at most one response per Ti is allowed)
# [NB: "question" refers to a (query id, slot name) pair; "answer" refers to a slot value]
# Two answer-strings are equivalent if, after removing leading and trailing white space from the answer-string, they are eq
# Messages regarding submission are printed to an error log

# The expected submission file format is:
#  Column 1: query ID
#  Column 2: slot name
#  Column 3: response type: one of "NIL", "V", "T1", "T2", "T3", or "T4"
#  Column 4: eight-digit date
#  Column 5: run id (team ID + "1", "2", or "3")
#  Column 6: document ID
#  Column 7: slot value

# The submission file for the KBP full temporal slot-filling task has
# at least one response for each temporal slot, for each query.  All
# TAC KBP 2011 temporal slots are list-valued.

# A response is a line of the form
#    query_id slot_name response_type date run_id docid answer-string-as-the-remainder-of-the-line
# OR
#    query_id slot_name NIL - run_id 
#
# where response_type is one of 'NIL', 'V', 'T1', 'T2', 'T3', 'T4'
# If response_type is 'V' or 'NIL', then date must be '-'

# This script also creates a new file, "input", in the current directory
# that has a more standard format (there will not be leading whitespace;
# and columns will be separated by one tab)

# Usage is:
#    check_kbp_temporal_slot-filling.pl results_file
#  where results_file is the name of the results submission file to be checked

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

my $MAX_ERRORS = 25;


my %trialqueries = 
 (SFT201 => {type => "PER",
           ignore => []},
  SFT290 => {type => "ORG",
           ignore => []});


# These values are specific to the TAC 2011 KBP track temporal slot-filling task
my %queries =
 (SFT200 => {type => "PER",
           ignore => []},
   SFT201 => {type => "PER",
           ignore => []},
   SFT202 => {type => "PER",
           ignore => []},
   SFT203 => {type => "PER",
           ignore => []},
   SFT204 => {type => "PER",
           ignore => []},
   SFT205 => {type => "PER",
           ignore => []},
   SFT206 => {type => "PER",
           ignore => []},
   SFT207 => {type => "PER",
           ignore => []},
   SFT208 => {type => "PER",
           ignore => []},
   SFT209 => {type => "PER",
           ignore => []},
   SFT210 => {type => "PER",
           ignore => []},
   SFT211 => {type => "PER",
           ignore => []},
   SFT212 => {type => "PER",
           ignore => []},
   SFT213 => {type => "PER",
           ignore => []},
   SFT214 => {type => "PER",
           ignore => []},
   SFT215 => {type => "PER",
           ignore => []},
   SFT216 => {type => "PER",
           ignore => []},
   SFT217 => {type => "PER",
           ignore => []},
   SFT218 => {type => "PER",
           ignore => []},
   SFT219 => {type => "PER",
           ignore => []},
   SFT220 => {type => "PER",
           ignore => []},
   SFT221 => {type => "PER",
           ignore => []},
   SFT222 => {type => "PER",
           ignore => []},
   SFT223 => {type => "PER",
           ignore => []},
   SFT224 => {type => "PER",
           ignore => []},
   SFT225 => {type => "PER",
           ignore => []},
   SFT226 => {type => "PER",
           ignore => []},
   SFT227 => {type => "PER",
           ignore => []},
   SFT228 => {type => "PER",
           ignore => []},
   SFT229 => {type => "PER",
           ignore => []},
   SFT230 => {type => "PER",
           ignore => []},
   SFT231 => {type => "PER",
           ignore => []},
   SFT232 => {type => "PER",
           ignore => []},
   SFT233 => {type => "PER",
           ignore => []},
   SFT234 => {type => "PER",
           ignore => []},
   SFT235 => {type => "PER",
           ignore => []},
   SFT236 => {type => "PER",
           ignore => []},
   SFT237 => {type => "PER",
           ignore => []},
   SFT238 => {type => "PER",
           ignore => []},
   SFT239 => {type => "PER",
           ignore => []},
   SFT240 => {type => "PER",
           ignore => []},
   SFT241 => {type => "PER",
           ignore => []},
   SFT242 => {type => "PER",
           ignore => []},
   SFT243 => {type => "PER",
           ignore => []},
   SFT244 => {type => "PER",
           ignore => []},
   SFT245 => {type => "PER",
           ignore => []},
   SFT246 => {type => "PER",
           ignore => []},
   SFT247 => {type => "PER",
           ignore => []},
   SFT248 => {type => "PER",
           ignore => []},
   SFT249 => {type => "PER",
           ignore => []},
   SFT250 => {type => "PER",
           ignore => []},
   SFT251 => {type => "PER",
           ignore => []},
   SFT252 => {type => "PER",
           ignore => []},
   SFT253 => {type => "PER",
           ignore => []},
   SFT254 => {type => "PER",
           ignore => []},
   SFT255 => {type => "PER",
           ignore => []},
   SFT256 => {type => "PER",
           ignore => []},
   SFT257 => {type => "PER",
           ignore => []},
   SFT258 => {type => "PER",
           ignore => []},
   SFT259 => {type => "PER",
           ignore => []},
   SFT260 => {type => "PER",
           ignore => []},
   SFT261 => {type => "PER",
           ignore => []},
   SFT262 => {type => "PER",
           ignore => []},
   SFT263 => {type => "PER",
           ignore => []},
   SFT264 => {type => "PER",
           ignore => []},
   SFT265 => {type => "PER",
           ignore => []},
   SFT266 => {type => "PER",
           ignore => []},
   SFT267 => {type => "PER",
           ignore => []},
   SFT268 => {type => "PER",
           ignore => []},
   SFT269 => {type => "PER",
           ignore => []},
   SFT270 => {type => "PER",
           ignore => []},
   SFT271 => {type => "PER",
           ignore => []},
   SFT272 => {type => "PER",
           ignore => []},
   SFT273 => {type => "PER",
           ignore => []},
   SFT274 => {type => "PER",
           ignore => []},
   SFT275 => {type => "PER",
           ignore => []},
   SFT276 => {type => "PER",
           ignore => []},
   SFT277 => {type => "PER",
           ignore => []},
   SFT278 => {type => "PER",
           ignore => []},
   SFT279 => {type => "PER",
           ignore => []},
   SFT280 => {type => "ORG",
           ignore => []},
   SFT281 => {type => "ORG",
           ignore => []},
   SFT282 => {type => "ORG",
           ignore => []},
   SFT283 => {type => "ORG",
           ignore => []},
   SFT284 => {type => "ORG",
           ignore => []},
   SFT285 => {type => "ORG",
           ignore => []},
   SFT286 => {type => "ORG",
           ignore => []},
   SFT287 => {type => "ORG",
           ignore => []},
   SFT288 => {type => "ORG",
           ignore => []},
   SFT289 => {type => "ORG",
           ignore => []},
   SFT290 => {type => "ORG",
           ignore => []},
   SFT291 => {type => "ORG",
           ignore => []},
   SFT292 => {type => "ORG",
           ignore => []},
   SFT293 => {type => "ORG",
           ignore => []},
   SFT294 => {type => "ORG",
           ignore => []},
   SFT295 => {type => "ORG",
           ignore => []},
   SFT296 => {type => "ORG",
           ignore => []},
   SFT297 => {type => "ORG",
           ignore => []},
   SFT298 => {type => "ORG",
           ignore => []},
   SFT299 => {type => "ORG",
           ignore => []});


# Temporal slots are subset of Slot Filler Type as defined in LDC publication 
# "TAC KBP Slots"; Version 1.2; June 2, 2011
my %slots = ('PER' => {
		 'per:countries_of_residence' => {quantity => 'list',
				      content => 'name'}, 
		 'per:stateorprovinces_of_residence' => {quantity => 'list',
				      content => 'name'}, 
		 'per:cities_of_residence' => {quantity => 'list',
				      content => 'name'}, 
		 'per:title' => {quantity => 'list',
				 content => 'string'}, 
		 'per:member_of' => {quantity => 'list',
				     content => 'name'}, 
		 'per:employee_of' => {quantity => 'list',
				       content => 'name'}, 
		 'per:spouse' => {quantity => 'list',
				  content => 'name'}},

	     'ORG' => {
		 'org:top_members/employees' => {quantity => 'list',
						 content => 'name'}});


my $results_file;		# input file name
my %qids;			# number of answers returned for question, response_type, and answer
my ($errlog,$num_errors,$line_num);
my ($run_id, $tag);
my ($q,$slot_name,$docid, $answer, $response_type, $date);
my ($num_response_types);
my ($i, $last_i, $line);

if ($#ARGV != 0) {
    print STDERR "Usage: $0 resultsfile\n";
    die "\n";
}
$results_file = $ARGV[0];
$num_errors = 0;

# set up output files 
$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" or
	die "Cannot open error log for writing\n";

open INPUT, ">input"   or die "Cannot create `input' file: $!\n";


open RESULTS, "<$results_file" or
    die "Unable to open results file $results_file: $!";
$line_num = 0;
$run_id = "";
while ($line = <RESULTS>) {
    chomp $line;
    $line_num++;

    next if ($line =~ /^\s*$/);
    $line =~ s/^\s*(.+\S)\s*$/$1/g;

    undef $slot_name;
    undef $tag;
    undef $docid,
    undef $answer;
    undef $response_type;
    undef $date;
    ($q, $slot_name, $response_type, $date, $tag, $docid, $answer) = split " ", $line, 7;
    
    if (!defined $tag or length($tag) == 0) {
	&error("Wrong number of fields -- missing fields");
	next;
    }
    
    if ($response_type ne "NIL" and (!defined $docid or !defined $answer)) {
	&error("Wrong number of fields -- missing fields");
	next;
    }

    	
    # make sure runtag is ok
    if (! $run_id) { 	# very first line --- remember tag 
	$run_id = $tag;
        if ($run_id !~ /^[A-Za-z0-9._]{1,12}[1-3]$/) {
            &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 query id
    if (!defined $queries{$q}) {
   	&error("Invalid query id ($q)");
	next;
    }
    # get slot name
    if (!defined $slots{$queries{$q}{'type'}}{$slot_name}) {
   	&error("Invalid slot name $slot_name for query $q with entity type $queries{$q}{'type'}");
	next;
    }

    if ($response_type eq "NIL") {
	if (defined $docid) {
	    &error("Wrong number of fields -- too many fields for NIL response");
	    next;
	}
	if ($date ne "-") {
	    &error("Invalid date for NIL response (date must be '-')");
	    next;
	}
	$qids{$q}{$slot_name}{$response_type}{""}++;
	print INPUT "$q\t$slot_name\t$response_type\t$date\t$tag\n";
	next;	
    } elsif ($response_type eq "V") {
	if ($date ne "-") {
	    &error("Invalid date for response with constraint 'V' (date must be '-')");
	    next;
	}
    } elsif ($response_type eq "T1" or $response_type eq "T2" or $response_type eq "T3" or $response_type eq "T4") {
    } else {
	&error("Invalid response type '$response_type' (must be 'NIL', 'V', 'T1', 'T2', 'T3', or 'T4')");
	next;
    }

    # make sure docid valid---
    # this is only an approximate test since so many docs for KBP track
    if ($docid !~ /(\.LDC.*[0-9]$)|(eng-WL-.*[0-9]$)|(eng-NG-.*[0-9]$)/) {
	&error("Unknown document `$docid'");
	next;
    } elsif ($docid =~ /(\.sgm)/) {
	&error("Unknown document ID `$docid' (looks like a file name instead of a document ID)");
	next;
    }

    # make sure answer exists				   
    if (!defined $answer or length($answer) == 0) {
	&error("Missing answer-string for slot $slot_name for query $q");
	next;
    }

    # make sure date is valid
    if ($date !~ /^([0-9]){8,8}$/ and $date ne '-' and $response_type ne "V" ) {
	&error("Invalid date $date for slot $slot_name for query $q for answer `$answer'");
	next;
    }
				    
    $qids{$q}{$slot_name}{$response_type}{$answer}++;
    print INPUT "$q\t$slot_name\t$response_type\t$date\t$tag\t$docid\t$answer\n";
}

# Do global checks:
#   error if some question that is not in the 'ignore' list has no response given for it
#   error if some question that is in the 'ignore' list has a response given for it
#   error if more than one response is given for a question where NIL has been given as an answer
#   error if more than one response for a question+answer+response_type for each response_type
#   error if more than one response for a question+answer if response_type is V for some response
foreach $q (keys %queries) {
    foreach $slot_name (keys %{$slots{$queries{$q}{'type'}}}) {
	if (! defined $qids{$q}{$slot_name} && -1 == &is_member($slot_name, \@{$queries{$q}{'ignore'}})) {
	    &error("No valid response given for slot $slot_name for query $q");
	}
	if (defined $qids{$q}{$slot_name}  && -1 != &is_member($slot_name, \@{$queries{$q}{'ignore'}})) {
	    &error("$qids{$q}{$slot_name} responses given for slot $slot_name, which should be ignored for query $q");
	}
	if (defined $qids{$q}{$slot_name}) {
	    $num_response_types = scalar ( keys %{$qids{$q}{$slot_name}} );
	    foreach $response_type (keys %{$qids{$q}{$slot_name}}) {
		if ($response_type eq "NIL") {
		    if ($num_response_types != 1 or $qids{$q}{$slot_name}{"NIL"}{""} != 1) {
			&error("More than one response given for slot $slot_name for query $q, where NIL has been given as a response");
		    }
		} else { # response_type is "V" or "T1" or "T2" or "T3" or "T4"; 
		    foreach $answer (keys %{$qids{$q}{$slot_name}{$response_type}}) {
			if ($qids{$q}{$slot_name}{$response_type}{$answer} != 1) {
			    &error("More than one response given for query $q, for slot $slot_name, for response type `$response_type' for answer `$answer'");
			}
			if ($response_type eq "V" and
			    (defined $qids{$q}{$slot_name}{"T1"}{$answer} or
			     defined $qids{$q}{$slot_name}{"T2"}{$answer} or
			     defined $qids{$q}{$slot_name}{"T3"}{$answer} or
			     defined $qids{$q}{$slot_name}{"T4"}{$answer})) {
			    &error("More than one response given for query $q, for slot $slot_name, for answer `$answer' when `V' has been given as a response type");  # cannot return any Ti temporal constraints for an answer when "V" has been returned as a response type for that answer
			}
		    }
		}
	    }
		
	}
    }
}
print ERRLOG "Finished processing $results_file\n";

close INPUT or die "Close failed for `input' file: $!\n";
close ERRLOG or die "Close failed for error log $errlog: $!\n";
if ($num_errors) { exit 255; }
exit 0;



 # print error message, keeping track of total number of errors
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 or
		die "Close failed for error log $errlog: $!\n";
	exit 255;
    }
}

#  Returns index of string element in array if present, else -1
sub is_member {
    my($element,$arrayref) = @_;
 
    my $i;
    for ($i=0; $i<= $#{$arrayref}; $i++) {
        if ($element eq $$arrayref[$i]) {
            return($i);
        }
    }
    return(-1);
}  

