#!/bin/sh -- # -*- perl -*- -w
eval 'exec perl -S $0 ${1+"$@"}'
    if 0;

# @(#)mswrap	22.1 12/08/98

&set_global_variables();

&get_commandline_options();

&my_trace("slurping input");
&get_alignment_output($alignment_filename,
		      \$ref_buf,
		      \$hyp_buf);

&my_trace("making ref input");
&make_muc_input(\@lexed_ref_toks,\$ref_buf);

&my_trace("making hyp input");
&make_muc_input(\@lexed_hyp_toks,\$hyp_buf);

&my_trace("writing ref input");
&write_tokens_to_outfile(\@lexed_ref_toks,
			 $muc_scorer_ref);
&my_trace("writing hyp input");
&write_tokens_to_outfile(\@lexed_hyp_toks,
			 $muc_scorer_hyp);

&make_muc_config();

&my_trace("running MUC_scorer");
if($sysstatus = system("$mucscorer $muc_scorer_config")){
    print "MUC_scorer failed: $sysstatus\n";
}

&my_trace("looking at output");
&calc_scores_file();
&calc_new_report_file();

########################################

sub my_trace{
    my ($message) = @_;
    if( $trace_is_on ){
	print "$message...\n";
	system "date '+%M:%S'";
    }
}


########################################

sub set_global_variables{

    # command line options

    # files visible to casual user
    $alignment_filename    = "";
    $tagbytag              = "tagbytag";
    $offset_tolerance      = "0";

    # intermediate files
    $muc_scorer_ref        = "mucscore.ref";
    $muc_scorer_hyp        = "mucscore.hyp";
    $muc_scorer_config     = "mucscore.cfg";
    $muc_scorer_report     = "mucscore.rpt";
    $muc_scorer_scores     = "mucscore.scr";


    # global variables
    $trace_is_on	   = 0;
    $no_pretty_report      = 0;
    $mucmetric             = 0;
    $ref_buf		   = "";
    $hyp_buf               = "";
    $DocGID                = "DOC";
    $report_comment_string = "#";
    $mucscorer             = "MUC_scorer";
    $SCORES                = "scores";
    $HUBSCORES             = 1;
    $MUCSCORES             = 1;

    @Premodifiers          = ("the", "an", "a");
}

########################################

sub get_commandline_options{
    use Getopt::Long;

    &GetOptions(
		"alignment_filename=s"     => \$alignment_filename,
		"tagbytag:s"               => \$tagbytag,
		"offset_tolerance:s"       => \$offset_tolerance,
		"mucscorer=s"              => \$mucscorer,
		"scores:s"                 => \$SCORES,
		"mucmetric"                => \$mucmetric,
		
		# "internal" files
		"muc_scorer_ref:s"         => \$muc_scorer_ref,
		"muc_scorer_hyp:s"         => \$muc_scorer_hyp,
		"muc_scorer_config:s"      => \$muc_scorer_config,
		"muc_scorer_report:s"      => \$muc_scorer_report,
		"muc_scorer_scores:s"      => \$muc_scorer_scores,

		"no_pretty_report"       => \$no_pretty_report
		);
    
    # strip quotes from values
    map {s/^\"(.*)\"$/$1/ or s/^\'(.*)\'$/$1/} ( # "
						$alignment_filename,
						$tagbytag,
						$SCORES,
						$offset_tolerance,

						# "internal" files
						$muc_scorer_ref,
						$muc_scorer_hyp,
						$muc_scorer_config,
						$muc_scorer_report,
						$muc_scorer_scores
						);
}

##############################
##############################
##############################

sub get_alignment_output{
    my ($alignment_filename,
	$r_ref_buf,
	$r_hyp_buf) = @_;

    my $line;

    open THEFILE, $alignment_filename 
	or die "couldn't open $alignment_filename";
    while( defined( $line = <THEFILE> ) ){
	if( $line =~ m/^REF:(.*)$/oi ){
	    $$r_ref_buf .= $1;
	} 
	elsif( $line =~ m/^HYP:(.*)$/oi ){
	    $$r_hyp_buf .= $1;
	}
    }
    close THEFILE;
}

##############################

sub make_muc_input{
    my ($r_result, $r_buf) = @_;
    local @toks = ();

    &my_trace("changing b_/e_ to <> </>");
    &change_task_tags_to_open_close($r_buf);

    &my_trace("shifting tags inside pre-modifiers");
    &shift_tags_inside_pre_modifiers($r_buf);

    &my_trace("changing min to alt");
    &change_min_to_alt($r_buf);

    &my_trace("changing fragment markers");
    &make_fragment_markers($r_buf);

    &my_trace("lexing contents");
    &lex_buf_alphanumpunct(\@toks,$r_buf);

    &my_trace("making input tags");
    &fix_atts(\@toks);

    &my_trace("removing text");
    &remove_unwanted_text($r_result,\@toks);
}

##############################

sub change_task_tags_to_open_close{
    my ($r_buf) = @_;

    $$r_buf =~ s[
		 <b_
		 (enamex|timex|numex)
		 ([^<>]*>)
		 ][
		   <$1$2>
		   ]xiog;

    $$r_buf =~ s[
		 <e_
		 (enamex|timex|numex)
		 ([^<>]*>)
		 ][
		   </$1$2>
		   ]xiog;
}

##############################

sub shift_tags_inside_pre_modifiers{
    my ($r_buf) = @_;
    my $premods_re = join "|", @Premodifiers;

    $$r_buf =~ s[
		 (<(?:enamex|timex|numex)[^<>]*>)   # open task tag
		 ((?:\s|\|)*)                       # spaces / vert. bars
		 ($premods_re)                      # premodifer
		 ((\s|\|)+)                         # premod. must be a token
		 ][$2$3$4$1]xiog;
}

##############################

sub change_min_to_alt{
    my ($r_buf) = @_;

    $$r_buf =~ s[
		 (<[^<>]*)
		 min=
		 ([^<>]*>)
		 ][
		   $1alt=$2
		   ]xiog;
}

########################################

sub make_fragment_markers{
    my $r_buf = shift @_;

    # Move fragment markers to beginning of words.
    # (Assume fragments are not split by SGML.)

    $$r_buf =~ s(
		 ([^<>\s\|]+)              # fragment
		  -                        # fragment marker
		  )(
		    -$1
		    )xiog;
}

########################################
########################################
########################################

sub fix_atts{
    my ($r_toks) = @_;
    my $i;
    my $offset_count=0;

    my $content_string;		# content att_val_pair
    my $alt_string;		# one content alternative

    my $extent_string;		# extent att_val_pair
    my $alt_extent_string;	# one extent alternative
    my $offset_string;		# offset att_val_pair

    my %att_val_pairs;		# all attribute/values in input tag
    my $gid;			# gid of input tag
    my $final_tag;              # the thing substituted into the text
    
    for( $i = 0; $i <= $#{$r_toks}; $i++ ) {
	if( $$r_toks[$i] eq "|" ) {
	    $offset_count++;
	} elsif( $$r_toks[$i] =~ m(
				   <
				   (ENAMEX|TIMEX|NUMEX)
				   ([^<>]|\"[^\"]*\")* # "
				   >
				   )xio ) {
	    $gid = $1;
	    &make_att_val_pairs(\%att_val_pairs, 
				$$r_toks[$i]);

	    ($alt_string,$alt_extent_string) =
		&make_content_string($i,
				     $r_toks,
				     $offset_count);
	    $content_string = "\n\tcont=\"$alt_string"; 
	    $extent_string =  "\n\txtnt=\"$alt_extent_string";
	    $offset_string =  "\n\toffset=\"$alt_extent_string\"";
	    
	    if( exists $att_val_pairs{"alt"} ){
		($alt_string,$alt_extent_string) =
		    &make_alt_string($att_val_pairs{"alt"},
				     $i,
				     $r_toks,
				     $offset_count);
		if( $alt_string ){
		    $content_string .= "|$alt_string";
		}
		if( $alt_extent_string ){
		    $extent_string .= "|$alt_extent_string";
		}
	    }
	    
	    $content_string .= "\"";
	    $extent_string .= "\"";
	    
	    $final_tag = 
		"<$gid".
		    "$content_string".
			"$extent_string".
			    "$offset_string";

	    # put in type, status, etc. attributes
	    foreach $attname (keys %att_val_pairs){
		next if (lc($attname) eq "alt");
		$final_tag .= "\n\t$attname=\"";
		$final_tag .= $att_val_pairs{$attname};
		$final_tag .= "\"";
	    }
	    
	    $final_tag .= ">";
		
	    $$r_toks[$i] = $final_tag;
	}
    }
}

########################################

sub make_att_val_pairs{
    my ($r_result, $tag) = @_;
    my @avps = ();

    %$r_result = ();
    @avps = ($tag =~ m(
		       \w+           # attribute name
		       \s*           # space before equals
		       =	     # equals sign
		       \s*	     # space after equals
		       (?:	     # three kinds of attribute values:
			(?:
			 \"[^\"]*\"  # " 1. double-quoted value
			 )
			|
			(?:
			 \'[^\']*\'  # 2. single-quoted value
			 )
			|
			\S+	     # 3. un-quoted value
			)
		       )xiog);
    foreach $avp (@avps){
	if( $avp =~ /^(\w+)\s*=\s*(\S.*)$/ ) {
	    my $hkey = lc $1;
	    my $hval = $2;
	    $hval =~ s/^\"([^\"]*)\"$/$1/; # "
	    $hval =~ s/^\'([^\']*)\'$/$1/; 
	    ${$r_result}{$hkey} = $hval;
	} else {
	    print STDERR "WARNING: couldn't parse atttribute value pair $avp\n";
	}
    }
}

########################################

sub make_content_string{
    my ($i, $r_toks, $offset_count) = @_;
    my $j;
    
    &find_close_tag($i, \$j, $r_toks);
    return 
	&build_lexseq_and_extent_from_text($i,
					   $j, 
					   $offset_count, 
					   $r_toks);
}

########################################

sub make_alt_string{
    my ($alt_string, $i, $r_lexemes, $offset_count) = @_;
    my $first_lexeme_index;
    my $last_lexeme_index;
    my $first_lexeme_offset;
    my @alt_lexemes;

    &lex_buf_alphanumpunct(\@alt_lexemes,\$alt_string);

    if( &find_alt_lexemes_in_text(\@alt_lexemes, 
				  $r_lexemes, 
				  $offset_count,
				  $i,
				  \$first_lexeme_index,
				  \$last_lexeme_index,
				  \$first_lexeme_offset
				  ) ) {
	return ("","");
    } else {
	return 
	    &build_lexseq_and_extent_from_text($first_lexeme_index,
					       $last_lexeme_index,
					       $first_lexeme_offset,
					       $r_lexemes);
    }
}

########################################

sub find_alt_lexemes_in_text{

    my ($r_alt_lexemes, 
	$r_toks, 
	$alt_tag_offset, 
	$i,
	$r_first_lexeme_index,
	$r_last_lexeme_index,
	$r_first_lexeme_offset
	) = @_;
    my $j;
    my $i0;

    # $i points to the tag in $r_toks 
    # containing the alt string.
    &find_close_tag($i, \$j, $r_toks);
    $i0 = &find_earliest_open_tag($i, 
				  $j, 
				  $r_toks, 
				  1 + $#{$r_alt_lexemes});
    if(&find_A_in_B(
		    $r_alt_lexemes, 
		    $r_toks,
		    $i0, 
		    $j,
		    $r_first_lexeme_index, 
		    $r_last_lexeme_index, 
		    ) ) {
	$$r_first_lexeme_offset = 
	    &calc_alt_offset($r_toks,
			     $i,
			     $alt_tag_offset,
			     $$r_first_lexeme_index);
	return 0;
    } else {
	return 1;
    }
}

########################################

sub find_earliest_open_tag{
    my ($i, $j, $r_toks, $alt_length) = @_;

    my $result = $i - 1;
    my $count = 0;

    while($count < $alt_length
	  &&
	  $result > 0) {
	while( ($result > 0) && (! is_word($$r_toks[$result]) ) ) {
	    $result--;
	}
	$count++;
    }
    return $result;
}

########################################

sub find_A_in_B{
    my ($r_A,
	$r_B,
	$b0,
	$bn,
	$r_first_lexeme_index,
	$r_last_lexeme_index) = @_;

    my $i;
    my $j;
    my $j0 = &next_word_index($r_B, $b0);
    my $result_flag = 0;

  FIRSTWORD:{
      while( $j0 <= $bn ) {
	  # find first word match
	  while(($j0 <= $bn)
		&&
		lc($$r_A[0]) ne lc($$r_B[$j0])){
	      $j0 = &next_word_index($r_B, $j0); 
	  }
	  # find rest of words
	  $i = 0;
	  $j = $j0;
	RESTOFWORDS:{
	    while(
		  $i <= $#{$r_A}
		  &&
		  $j <= $#{$r_B}
		  ){
		# increment counters if they match
		if((lc $$r_A[$i]) eq (lc $$r_B[$j]) ){
		    $i++;
		    $j = &next_word_index($r_B, $j);
		} else {
		    # try next first word
		    $j0 = &next_word_index($r_B, $j0);
		    last RESTOFWORDS;
		}
	    }
	    # we've reached end of either A or B, so we're done
	    if( $i > $#{$r_A} ) {
		# success!
		$$r_first_lexeme_index = $j0;
		# $j is one past what we want, so back up
		$$r_last_lexeme_index = &prev_word_index($r_B,$j);
		$result_flag = 1;
	    } 
	    last FIRSTWORD;
	} # end of RESTOFWORDS
      }	 # end of while(j0 < bn)...
  }	 # end of FIRSTWORD
    return $result_flag;
}

########################################

sub calc_alt_offset{
    my ($r_toks,
	$alt_tag_index,
	$alt_tag_offset,
	$first_lexeme_index) = @_;

    my $i = $alt_tag_index;
    my $result = $alt_tag_offset;

    if( $alt_tag_index < $first_lexeme_index ){

	while( $i < $first_lexeme_index ) {
	    if( $$r_toks[$i] eq "|" ) {
		$result++;
	    }
	    $i++;
	} 

    } else {

	while( $i >= $first_lexeme_index ) {
	    if( $$r_toks[$i] eq "|" ) {
		$result--;
	    }
	    $i--;
	}

    }
    return $result;
}

########################################

sub next_word_index{
    my ($r_A,
	$i) = @_;
    my $result = $i + 1;
    
    while($result <= $#{$r_A}
	  &&
	  (! &is_word($$r_A[$result])
	   ||
	   &is_filler($$r_A[$result]) ) ) {
	$result++;
    }
    return $result;
}

########################################

sub prev_word_index{
    my ($r_A,
	$i) = @_;
    my $result = $i - 1;
    
    while($result >= 0
	  &&
	  (! &is_word($$r_A[$result])
	   ||
	   &is_filler($$r_A[$result]) ) ) {
	$result--;
    }
    return $result;
}

########################################

sub find_close_tag{
    # assume: 
    #  1. $i holds position in @$r_toks of start tag.
    #  2. $j will hold position in @$r_toks of end tag.

    my ($i, $r_j, $r_toks) = @_;
    my $gid;
    my $nesting = 0;
    my $k = $i + 1;
    my $found = 0;

    $gid = $$r_toks[$i];
    $gid =~ s/^<(\w+).*$/$1/;
    
    while($k <= $#{$r_toks}
	  &&
	  (! $found)){
	if($nesting == 0
	   &&
	   $$r_toks[$k] =~ m/<\/$gid\s*>$/i){
	    $$r_j = $k;
	    $found = 1;
	} elsif ($$r_toks[$k] =~ m/<$gid\s.*>$/i){
	    $nesting++;
	} elsif ($$r_toks[$k] =~ m/<\/$gid\s*>$/i){
	    $nesting--;
	}
	$k++;
    }
    if( ! $found ){
	print "can't find close tag for $$r_toks[$i]\n";
	exit(1);
    }
}

########################################

sub build_lexseq_and_extent_from_text{
    my ($first_lexeme_index,
	$last_lexeme_index,
	$offset,
	$r_lexemes) = @_;
    my $result_lexseq = "";
    my $result_extent = "$offset.";
    my @text_lexemes = 
	@$r_lexemes[$first_lexeme_index..$last_lexeme_index];
    my $text_lexeme;
    my $altjump;

    while( $text_lexeme = shift @text_lexemes ) {
	if( $text_lexeme eq "|") {
	    $offset++;
	} elsif( &is_word($text_lexeme) ){
	    $altjump = &is_optional($text_lexeme);
	    $text_lexeme =~ s/\[/\\\[/g;
	    $text_lexeme =~ s/\]/\\\]/g;
	    $result_lexseq .=  $text_lexeme;
	    $result_lexseq .= "[$offset,$altjump]";
	}
    }

    $result_extent .= $offset;

    return ($result_lexseq, $result_extent);
}

########################################

sub remove_unwanted_text{
    my ($r_result, $r_toks) = @_;
    my $tok;

    # There may be a token "0" in the text, so the
    # long-winded while loop.

    $tok = shift @$r_toks;
    while( defined $tok ) {
	if($tok =~ /<((ENAMEX)|(TIMEX)|(NUMEX))/io) {
	    push @$r_result, "$tok\n";
	}
	$tok = shift @$r_toks;
    }
}


########################################

sub is_optional{
    my $lexeme = shift @_;
    if( $lexeme =~ /^(%|-)/ ){
	return 1;
    } else {
	return 0;
    }
}

########################################

sub lex_buf_alphanumpunct{
    my ($r_tokens, $r_buf) = @_;

    @$r_tokens= ($$r_buf =~ m(
			      <[^<>]*>     # tags
			      
			      |
			      
			      (?:%|-)[^\s\|<>]+   # pause fillers or fragments
			                        # (assumes no tags attached)

			      |

			      [A-Za-z0-9]+ # alphanumeric
			      
			      |
			      
			      \S           # anything else (but spaces)
			      
			      )xg
		 );
}

########################################

sub is_filler{
    my ($lexeme) = @_;
    return ($lexeme =~ /^%/o );
}

########################################

sub is_word{
    my ($datum) = @_;
    return $datum =~ m(
		       ^
		       [^\s<>\|]+ # word
		       $
		       )oxg;
}

########################################

sub write_tokens_to_outfile {
    my ($r_toks, $outFile) = @_;

    open OUTFILE, ">$outFile" 
	or die "couldn't open $outFile for writing";

    print OUTFILE "<$DocGID>\n";
    print OUTFILE join "\n", @{$r_toks};
    print OUTFILE "\n";
    print OUTFILE "</$DocGID>\n";

    close OUTFILE;
}


########################################
########################################
########################################

sub calc_new_report_file{
    if( $no_pretty_report ){
	&copy_muc_report();
    } else {
	&make_pretty_report();
    }
}

sub copy_muc_report{
    my $line;

    open RFILE, "$muc_scorer_report"
	or die "$0: couldn't open $muc_scorer_report";
    open OFILE, ">$tagbytag"
	or die "$0: couldn't open $tagbytag";
    while( defined ($line = <RFILE>) ){
	chomp $line;
	if( $line !~ /^\#/ ){	# change * to ' ' in non-comments
	    $line =~ s/\*/ /g;
	}
	print OFILE "$line\n";
    }
    close RFILE;
}

sub make_pretty_report{
    my $line;
    local ($tag,
	   $cs,
	   $rcontent,
	   $hcontent,
	   $es,
	   $rextent,
	   $hextent,
	   $ts,
	   $rtype,
	   $htype,
	   @rest);
    # Then pad each field by the required number of spaces.
    open RFILE, "$muc_scorer_report"
	or die "$0: couldn't open $muc_scorer_report";
    open PRETTYREPORT, ">$tagbytag"
	or die "$0: couldn't open $tagbytag";
    while( defined( $line = <RFILE>) ){
	next if( $line =~ /^\#/ );
	chomp $line;
	# change * to ' '
	$line =~ s/\*/ /g;
	($tag,
	 $cs,
	 $rcontent,
	 $hcontent,
	 $es,
	 $rextent,
	 $hextent,
	 $ts,
	 $rtype,
	 $htype,
	 @rest) = split /\|/, $line;
	write PRETTYREPORT;
    }
    close RFILE;
    close PRETTYREPORT;
}

########################################

sub calc_scores_file{


    my $line;
    my @fields;

    local $cont;
    local $xtnt;
    local $type;
    local $text;
    my $category;
    my %totaltallies = ('cont' => &init_tallies(),
			'xtnt' => &init_tallies(),
			'type' => &init_tallies(),
			'text' => &init_tallies(),
			'hubtotal' => &init_tallies(),
			'muctotal' => &init_tallies());
    open SFILE, "$muc_scorer_report" 
	or die "couldn't open $muc_scorer_report for reading";
    while (defined($line = <SFILE>)){
	chomp $line;
	# ignore comments
	next if( $line =~ /^\#/ );
	# change stars to spaces
	$line =~ s/\*/ /g;
	@fields = split /\s*\|\s*/, $line;

	$cont = lc $fields[1];
	$xtnt = lc $fields[4];
	$type = lc $fields[7];

	if(($cont eq 'cor') and ($xtnt eq 'cor') ) {
	    $text = 'cor';
	} elsif(($cont eq 'inc') or ($xtnt eq 'inc') ) {
	    $text = 'inc';
	} else {
	    $text = $cont;
	}
	
	foreach $category ('cont', 'xtnt', 'type', 'text' ) {
	    &tally1_line($category,
			 $$category,
			 \%totaltallies );
	}
    }
    close SFILE;

    foreach $category ('cont', 'xtnt', 'type' ){
	&combine_tallies($totaltallies{$category},
			 $totaltallies{'hubtotal'});
    }

    foreach $category ('text', 'type' ){
	&combine_tallies($totaltallies{$category},
			 $totaltallies{'muctotal'});
    }
    
    foreach $category ('cont', 
		       'xtnt', 
		       'text', 
		       'type',
		       'hubtotal',
		       'muctotal' ) {
	&compute_f($totaltallies{$category});
    }
	
    &print_tallies(\%totaltallies);
}

########################################

sub init_tallies{
    return {
	'pos' => 0,
	'act' => 0,
	'cor' => 0,
	'inc' => 0,
	'mis' => 0,
	'spu' => 0,
	'opt' => 0,
	};
}
	
########################################

sub combine_tallies{
    my ($r_adder,$r_addee) = @_;

    $$r_addee{'pos'} += $$r_adder{'pos'};
    $$r_addee{'act'} += $$r_adder{'act'};
    $$r_addee{'cor'} += $$r_adder{'cor'};
    $$r_addee{'inc'} += $$r_adder{'inc'};
    $$r_addee{'mis'} += $$r_adder{'mis'};
    $$r_addee{'spu'} += $$r_adder{'spu'};
    $$r_addee{'opt'} += $$r_adder{'opt'};
}
	

########################################

sub tally1_line{
    my ($category, $status, $r_tallies) = @_;

    if( $status eq 'cor'){
	$$r_tallies{$category}{'pos'}++;
	$$r_tallies{$category}{'act'}++;
	$$r_tallies{$category}{'cor'}++;
    } elsif( $status eq 'inc'){
	$$r_tallies{$category}{'pos'}++;
	$$r_tallies{$category}{'act'}++;
	$$r_tallies{$category}{'mis'}++;
	$$r_tallies{$category}{'spu'}++;
    } elsif( $status eq 'mis' ){
	$$r_tallies{$category}{'pos'}++;
	$$r_tallies{$category}{'mis'}++;
    } elsif( $status eq 'spu' ){
	$$r_tallies{$category}{'act'}++;
	$$r_tallies{$category}{'spu'}++;
    }
}

########################################

sub compute_f{
    my ($r_tallies) = @_;

    my $pa = $$r_tallies{'pos'} + $$r_tallies{'act'} ;
    if( $pa ){
	$$r_tallies{'f'} = 
	    sprintf "%4.2f", (2.0 * $$r_tallies{'cor'}) / $pa;
    } else {
	$$r_tallies{'f'} = 0;
    }
}

########################################

sub print_tallies{
    my ($r_tallies) = @_;

    if( $mucmetric ){
	&print_muc_tallies($r_tallies);
    } else {
	&print_hub_tallies($r_tallies);
    } 
}

########################################

sub print_hub_tallies{
    local ($r_tallies) = @_;
    local %namemap = ('cont' => 'Content', 
		      'xtnt' => 'Extent',
		      'type' => 'Type',
		      'hubtotal' => 'TOTAL',
		      );
    my $name;
    
    open HUBSCORES, ">$SCORES"
	or die "couldn't open $SCORES for writing\n";
    
    foreach $name ('cont','xtnt','type','hubtotal') {
	local $slot = $namemap{$name};
	local $pos  = $$r_tallies{$name}{'pos'};
	local $act  = $$r_tallies{$name}{'act'};
	local $cor  = $$r_tallies{$name}{'cor'};
	local $mis  = $$r_tallies{$name}{'mis'};
	local $spu  = $$r_tallies{$name}{'spu'};
	local $f    = $$r_tallies{$name}{'f'};

	write HUBSCORES;
    }
    close HUBSCORES;
}

########################################

sub print_muc_tallies{
    local ($r_tallies) = @_;
    local %namemap = ('type' => 'Type',
		      'text' => 'Text', 
		      'muctotal' => 'TOTAL'
		      );
    my $name;
    
    # Append if we've already written the hub scores.
    open MUCSCORES, ">$SCORES"
	or die "couldn't open $SCORES for writing\n";

    foreach $name ('text','type','muctotal') {
	local $slot = $namemap{$name};
	local $pos  = $$r_tallies{$name}{'pos'};
	local $act  = $$r_tallies{$name}{'act'};
	local $cor  = $$r_tallies{$name}{'cor'};
	local $mis  = $$r_tallies{$name}{'mis'};
	local $spu  = $$r_tallies{$name}{'spu'};
	local $f    = $$r_tallies{$name}{'f'};

	write MUCSCORES;
    }
    close MUCSCORES;

}

########################################

sub make_muc_config{

    my $config_contents = <<__;
#
# This is a configuration file for the "MUC_scorer" program,
# generated by the script $0
#
:key_file               $muc_scorer_ref
:response_file          $muc_scorer_hyp
:report_summary_file    $muc_scorer_report
:score_report_file      $muc_scorer_scores

:scoring_task		named_entity
:scoring_method		key2response

:sgml_DOC_gid           $DocGID
:doc_sections           $DocGID
:count_sgml		no
:sgml_CONTENT_slot	cont
:sgml_EXTENT_slot	xtnt
:sgml_offset_attribute  offset
:extract_from_text      no
:report_lexeme_separator  "*"
:report_comment_string  "$report_comment_string"

:ne_offset_tolerance	$offset_tolerance
:ne_allow_incorrect	yes
:fragment_prefix_char   "-"

:class_defs "enamex	enamex	scored	0"
	    "numex	numex	scored	0"
            "timex	timex	scored	0"

:slot_defs
    "enamex	cont	cont	scored		4	lexseq"
    "enamex	xtnt	xtnt	scored		4	extent"
    "enamex	type	type	scored		4	set"
    "enamex	status	status	unscored	4	set"
    "enamex	offset	offset	unscored	4	extent"

    "timex	cont	cont	scored		4	lexseq"
    "timex	xtnt	xtnt	scored		4	extent"
    "timex	type	type	scored		4	set"
    "timex	status	status	unscored	4	set"
    "timex	offset	offset	unscored	4	extent"


    "numex	cont	cont	scored		4	lexseq"
    "numex	xtnt	xtnt	scored		4	extent"
    "numex	type	type	scored		4	set "
    "numex	status	status	unscored	4	set"
    "numex	offset	offset	unscored	4	extent"


__

    open CONFIG, ">$muc_scorer_config" 
	or die
	    "couldn't open the file $muc_scorer_config for writing";
    print CONFIG $config_contents, "\n";
    close CONFIG;
}


    format HUBSCORES_TOP = 



HUB Scoring Metrics:
Category  | Possible | Actual | Correct | Missing | Spurious | F-measure
----------+----------+--------+---------+---------+----------+----------
.

    format HUBSCORES =
@<<<<<<<< | @>>>>>>> | @>>>>> | @>>>>>> | @>>>>>> | @>>>>>>> | @>>>>>>>>
$slot,      $pos,      $act,    $cor,     $mis,     $spu,      $f
.

    format MUCSCORES_TOP = 



MUC Scoring Metrics:
Category  | Possible | Actual | Correct | Missing | Spurious | F-measure
----------+----------+--------+---------+---------+----------+----------
.

    format MUCSCORES =
@<<<<<<<< | @>>>>>>> | @>>>>> | @>>>>>> | @>>>>>> | @>>>>>>> | @>>>>>>>>
$slot,      $pos,      $act,    $cor,     $mis,     $spu,      $f
.

    format PRETTYREPORT_TOP =
-------+----------------------------------------------------+-----------------------------+-----------------------------
Tag    | CONTENT                                            | EXTENT                      | TYPE
Name   |       Ref                    Hyp                   |     Ref           Hyp       |     Ref          Hyp
-------+-----+----------------------+-----------------------+-----------------------------+-----------------------------
.

    format PRETTYREPORT =
@<<<<< | @<< | ^<<<<<<<<<<<<<<<<<<< | ^<<<<<<<<<<<<<<<<<<<< | @<< @<<<<<<<<<< @<<<<<<<<<< | @<< @<<<<<<<<<<< @<<<<<<<<<<< 
$tag,    $cs,  $rcontent,             $hcontent,              $es,$rextent,   $hextent,     $ts,$rtype,      $htype
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
~      |     |     ^<<<<<<<<<<<<<<< |    ^<<<<<<<<<<<<<<<<< |                             |
                   $rcontent,             $hcontent
.
