# $Id: Seikai.pm,v 3.0 1998/11/19 07:13:13 tsuchiya Exp $

# This file is part of IREX tools.

# Please refer "Copyright file" at the root directory.
# (C) IREX committee IREX実行委員会. All rights reserved.  


# TREC 正解ファイルを扱うための関数を定義したモジュール


package TREC::Seikai;
require 5.000;
require Exporter;
use Carp;
use IREX::Common qw( @BUF %TREE );
@ISA         = qw( Exporter );
@EXPORT_OK   = qw( parser parse @BUF generator generate %TREE );
%EXPORT_TAGS = ( parser    => [qw( parse @BUF )],
		 generator => [qw( generate %TREE )] );



# @BUF に格納されているファイルを対象として構文解析を行う関数
#
# 1行の形式が次のようになっているファイルを扱う。
#	0001	A	98093022	0
# 各フィールドは \t によって区切られている。
#	第1フィールド = TOPIC-ID
#	第2フィールド = ダミー
#	第3フィールド = 文書番号
#	第4フィールド = 正解の場合 1 / 不正解の場合 0
#
# ファイルから得られる情報のみでは、IREX 結果統合ファイル形式
# への変換ができないので、対象となっている TREC 正解ファイルを
# 作成した審判の PID を引数として指定する必要がある。
#
# また、正解、不正解と A,B,C の3値との対応関係も復元できないの
# で、正解を A 判定とし、不正解を C 判定としている。
sub parse ( $ ) {
    my( $pid )=@_;
    for( @BUF ){
	/^(\d+)\t[^\t\r\n]+\t([^\t\r\n]+)\t(\d+)$/ or
	    warn( "Can't parse line \"$_\"\n" ), return 0;
	$TREE{$1}->{$2}->{JUDGE}->{$pid} = sprintf( "<JUDGE PID=%04d>%s</JUDGE>", $pid, $3 ? "A" : "C" );
    }
    1;
}



# 構文木 %TREE からデータを生成する関数
#
# %TREE には、IREX 結果統合ファイル形式のデータが格納されている。
# このデータの中から引数で指定された関数の返り値から正解/不正解の
# 2値を獲得して、TREC 正解ファイル形式に変換する。
sub generate ( $ ) {
    my $func = shift;
    ( ref($func) eq "CODE" )||die "Illegal argument";

    for $topic_id ( sort keys %TREE ){
      DOCNO: for $docno ( sort keys %{ $TREE{$topic_id} } ){
	    my $ref = $TREE{$topic_id}->{$docno}->{JUDGE};
	    my %judge;
	    for $pid ( keys %{ $ref } ){
		$ref->{$pid}=~m!>\s*([ABC]\??)\s*</!
		    or warn( "Can't find score in \"",$ref->{$pid},"\"\n" ),return 0;
		$judge{$pid}=$1;
	    }
	    my $score = &$func( $topic_id, $docno, %judge );
	    if( $score == 1 ){
		printf( "%s\t1\t%s\t1\n",$topic_id,$docno );
	    } elsif(( $score==0 )&&( defined $score )){
		printf( "%s\t0\t%s\t0\n",$topic_id,$docno );
	    } else {
		warn( "Not correctry judged data exists.",
		      " TOPIC-ID=",$topic_id,
		      " DOCNO=",$docno,
		      " VALUE=",$score ? "\"$score\"" : "(undef)","\n" );
		return 0;
	    }
	}
    }
    1;
}

1;