#!/usr/bin/perl
$version = 'Time-stamp: "2004-03-28 15:18:40 yamagen"';
$version =~ s/Time-stamp/Version/g;
$version =~ s/\"//g;
# kokin_stat.pl
#
# kokin statistics display
#
######################################################
require "../private/lib/jcode.pl";
require "../private/lib/site-lib.pl";
require "../private/lib/cgi-lib.pl";
&ReadParse;

$appli_name    ='./analysis021.pl';   ## 755
$show_name      ='./show_wk.pl';   ## 755
$home_name     ='../kokin.html';   ## 755
$info_name     ='../kokin_info.html';   ## 755
$help_name     ='../kokin_help.html';   ## 755
$config_file   ='../private/lib/site.conf';           ## 666

#setting
$html = 1;

use POSIX qw(strftime);
$ddate       = strftime "%a %b %e %H:%M:%S %Y", localtime;
$fdate       = strftime "%Y/%m/%d %a %H:%M:%S", localtime;

$this_title    ='OP and CJT';
$dic_file      ='../tagged021/tagged-kokin.dat'; ## readable check!
$flag_dir      ='../image/flags/';  ## readable check!
$CharSet       ='x-euc-jp'; 
#
$|=1;
######################################################
# main
#####################################################

if ($in{'protocol'} eq 'calc') {    calc_html();   }
if ($in{'protocol'} eq '')     {    index_html();   }

######################################################
# sub 
######################################################

sub index_html {
    open_config($config_file);
    cgi_header();
    print_tools();
    html_header();
    form();
    html_footer();
}

sub form {
    my $name = get_cjt_name();

    print <<FO;
<form method='POST' action=$appli_name>
<input type='hidden' name='protocol' value='calc'>
<input type='radio' name='show' value='all'>show list<br>
<input type='radio' name='show' value='no' checked>don't show
<table><tr>
<td>
<select name='cjt'>
<option value='none'>None
$name
</select>
<!--    <tr><td> Key: <input type='text' name='Key' size=10></tr>-->
Num: <input type='text' name='Num' size=10>
     <input type='submit' name='submit' value='OK'>
</tr>
</table>
</form>
FO
}

sub get_cjt_name {
    my $name = '';
    my @cjt_name = <../tagged021/tagged\-*.dat>;
    foreach (@cjt_name) {
	if (!/kokin.dat/) {
	    /tagged\-(.+)\.dat/;
	    $name .= "<option value='$_'>$1\n";
	}
    }
    return $name;
}

sub calc_html {
    open_config($config_file);
    cgi_header();
    print_tools();
    html_header();
#  jcode::convert(\$in{'Key'}, "euc");
  jcode::convert(\$in{'Num'}, "euc");
    if ($debug) {
	foreach $i (sort keys %in) {
	    print "$i $in{$i}<br>\n";
	}
    }
    my $vnop = read_dic($in{'Num'});
    my $vncjt = cjt_dic($in{'Num'},$in{'cjt'});
    print_result($vnop, $vncjt);
    html_footer();
}

# OPのデータを読み込む。

sub read_dic{
    my $num = $_[0];
    my $true = 0;
    my $validv = 0;

    print "<p>\n" if ($html);
    print "OP -- $num $dic_file\n";
    print "<br>\n" if ($html);
    print "<pre>\n" if ($html && ($in{'show'} eq 'all'));

    open(LG, $dic_file) or die ("can't open $dic_file.");
    while (<LG>) {
	chomp;
	my ($iid,$pos,$shu,$hir,$kan,$meta) = split(/\s+/,$_);
	if ($num eq int(substr($iid,2,6))) {
	    print "$_\n" if ($in{'show'} eq 'all');
	    $opline .= "/$shu";
	    $validv++ if $meta ne '----';
	    print "[Error: $pos - $kan]<br>\n" if $meta eq '****';
	    my @metaline = split(/\,/,$meta);
	    foreach $i (@metaline) {
		$wop{wider($i)} = $kan;
		$op{$i} = $kan;
	    }
	    $oplist .= ',' if ($oplist && $meta ne '----');
	    $oplist .= $kan if $meta ne '----';
	    $true = 1;
	}
	last if ($true && $num ne int(substr($iid,2,6)));
    }
    close(LG);
    $opline .= "/";
    print "</pre>\n" if ($html && ($in{'show'} eq 'all'));
    print "$opline\n";
    print "<br>\n" if ($html);
    printf "Num of valid vocabulary: %d\n",$validv;
    print "<br>\n" if ($html);
    return $validv;
}

# cjt の一致を試みる。

sub cjt_dic{
    my $num = $_[0];
    my $cjt = $_[1];
    my $true = 0;
    my $validv = 0;

    print "<p>\n" if ($html);
    print "CJT -- $num $cjt\n";
    print "<br>\n" if ($html);
    print "<pre>\n" if ($html && ($in{'show'} eq 'all'));

    open(LG, $cjt) or die ("can't open $cjt.");
    while (<LG>) {
	chomp;
	my ($au,$else) = split(/:/,$_);
	my ($iid,$pos,$shu,$hir,$kan,$meta) = split(/\s+/,$else);
	if (int($num) == int($iid)) {
	    $true = 1;
	    print "$_\n" if ($in{'show'} eq 'all');
	    $cjtline .= "/$shu";
	    print "[Error: $pos - $kan]<br>\n" if $meta eq '****';
	    if ($meta ne '----' && $pos ne '感動詞') {
		$validv++;
		my @metaline = split(/\,/,$meta);
		$ok = 0;

		foreach $i (@metaline) {
		    $w = $i;
		    if ($op{$w} && !$found{$op{$w}}) {
			$found{$op{$w}} = 1;
			($tmp,$void) = split(/\(/,$w);
			$both .= "$op{$w},$kan($tmp)/";
			$bothcount++;
			$ok = 1;
			last;
		    }
		}
		if (!$ok) {
		    foreach $i (@metaline) {
			$w = wider($i);
			if ($wop{$w} && !$found{$wop{$w}}) {
			    $found{$wop{$w}} = 1;
			    ($tmp,$void) = split(/\(/,$w);
			    $sboth .= "$wop{$w},$kan($tmp)/";
			    $sbothcount++;
			    $ok = 1;
			    last;
			}
		    }
		}

		if (!$ok && !$fail{$kan}) {
		    $fail{$kan} = 1;
		    $cjtfail .= "$kan/";
		    $cjtfailcount++;
		}
	    }
	}
	last if ($true && int($num) != int($iid));
    }
    close(LG);
    $cjtline .= "/";
    print "</pre>\n" if ($html && ($in{'show'} eq 'all'));
    print "$cjtline\n";
    print "<br>\n" if ($html);
    printf "Num of valid vocabulary: %d\n",$validv;
    print "<br>\n" if ($html);
    return $validv;
}

sub print_result {
    my $vnop = $_[0];
    my $vncjt = $_[1];
    
    print "<br>\n" if ($html);
    printf "Yes(exact): /%s = %d\n", $both, $bothcount;
    print "<br>\n" if ($html);

    printf "Yes(table): /%s = %d\n", $sboth, $sbothcount;
    print "<br>\n" if ($html);

    print "<br>\n" if ($html);
    print "No(org): /";
    my $nop = 0;
    @opword = split(/\,/,$oplist);
    foreach $i (@opword) {
	if (!$found{$i}) {
	    print "$i/";
	    $nop++;
	}
    }
    print " = $nop\n";
    print "<br>\n" if ($html);


    print "No(cjt): /$cjtfail\n";
    print " = $cjtfailcount\n";
    print "<br>\n" if ($html);

    print "\n";
    print "<br>\n" if ($html);

    print "<br>Ingredient of OP<br>\n" if ($html);
    $A = 1 - (($vnop - $bothcount) / $vnop);
    printf("A = %6.2f ...", $A );
    print "ratio of exact agreement : (OP - exact(OP cap CJT)) / OP\n";
    print "<br>\n" if ($html);

    $S = 1 - (($vnop - $sbothcount) / $vnop);
    printf("S = %6.2f ...", $S );
    print "ratio of table agreement : (OP - table(OP cap CJT)) / OP\n";
    print "<br>\n" if ($html);

    $T = 1 - (($vnop - $bothcount - $sbothcount) / $vnop);
    printf("T = %6.2f ...", $T );
    print "ratio of total agreement : A + S\n";
    print "<br>\n" if ($html);

    $R = 1 - $T;
    printf("R = %6.2f ...", $R );
    print "ratio of residual : 1 - T\n";
    print "<br>\n" if ($html);




    print "<br>Ingredient of CJT<br>\n" if ($html);
    $O = $bothcount / $vncjt;
    printf("O = %6.2f ...", $O );
    print "ratio of original words: exact(OP cap CJT) / CJT\n";
    print "<br>\n" if ($html);

    $E = ($vncjt - $bothcount) / $vncjt;
    printf("E = %6.2f ...", $E );
    print "ratio of annotation: CJT - exact(OP cap CJT) / CJT\n";
    print "<br>\n" if ($html);

    print "-- Breakdown of the annotation.<br>\n";
    $P = $E * ($S + $R);
    printf("&nbsp;&nbsp; P = %6.2f ...", $P );
    print "ratio of paraphrased: E(S + R)\n";
    print "<br>\n" if ($html);

    $D = $E - $P;
    printf("&nbsp;&nbsp; D = %6.2f ...", $D );
    print "ratio of purely added portion: E - P\n";
    print "<br>\n" if ($html);

}

sub wider {
    my $num = $_[0];
    if ($num =~ /^KA/){ $num = substr($num,0,7); }
    if ($num =~ /^CH/){ $num = substr($num,0,5); }
    if ($num =~ /^[1234]/){
	$num =~ /.\.(.+\-.+)\-.+/;
	$num = $1;
    }
    return $num;
}
