adj_gen.pm 4.23 KB
Newer Older
priyank's avatar
priyank committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
package ILMT::HIN::PAN::Morph::adj_gen;

use Exporter qw(import);
use ILMT::HIN::PAN::SSFAPI::feature_filter;
use ILMT::HIN::PAN::SSFAPI::shakti_tree_api;

our @EXPORT = qw(adj_gen);

sub adj_gen {
    my ($input, $output) = @_;

    open ($infile, '<', $input) or die "$!";
    open ($outfile, '>', $output) or die "$!";

    while($line=<$infile>)
    {
        chomp ($line);
        ($addr, $tkn, $pos, $fs) = split(/\t/,$line);
        if($fs ne "")
        {
            @fss = split(/\|/, $fs);
            my $len = @fss;
            @string  = "";
            $newfs = "";
            my $i=0;
            foreach $af (@fss)
            {
                my $FSreference = &read_FS($af, $line);
                my @lex_val = &get_values("lex", $FSreference);
                my @cat_val = &get_values("cat", $FSreference);
                my @gen_val = &get_values("gen", $FSreference);
                my @num_val = &get_values("num", $FSreference);
                #print "lex:$lex cat:$cat gen:$gen num:$num\n";

                if ($lex_val[0] =~ /(\.)*I$/ and $cat_val[0] eq "adj" and $gen_val[0] eq "f" and $num_val[0] eq "any")
                {
                    $lex = $lex_val[0];
                    $lex =~ s/I$/A/;
                    #print "my lex $lex";
                    my @lex_arr=();
                    push @lex_arr,$lex;
                    &update_attr_val("lex", \@lex_arr, $FSreference, $af);
                    $string[$i] = &make_string($FSreference, $af);
                }
                elsif ($lex_val[0] =~ /(\.)*(IM|Iz)$/ and $cat_val[0] eq "adj" and $gen_val[0] eq "f" and $num_val[0] eq "any")
                {
                    $lex = $lex_val[0];
                    $lex =~ s/(IM|Iz)$/Az/;
                    #print "my lex $lex";
                    my @lex_arr=();
                    push @lex_arr,$lex;
                    &update_attr_val("lex", \@lex_arr, $FSreference, $af);
                    $string[$i] = &make_string($FSreference, $af);
                }
                else
                {
                    $lex = $lex_val[0];
                    my @lex_arr=();
                    push @lex_arr,$lex;
                    &update_attr_val("lex", \@lex_arr, $FSreference, $af);
                    $string[$i] = &make_string($FSreference, $af);

                }


                $i++;
            }
            foreach $string (@string)
            {
                if(--$len)
                {
                    $newfs=$newfs.$string."|";
                }
                else
                {
                    $newfs=$newfs.$string;
                }
            }
            delete @string[0..$#string];
            delete @lex_root[0..$#lex_root];
            delete @fss[0..$#fss];
            if($line =~ /\(\(/ or $line =~ /\)\)/)
            {
                ($addr1,$lex,$pos,$fs) = split(/\t/,$line);
                if ($output ne "")
                {
                    #print $outfile $num,"\t",$lex,"\t",$pos,"\t",$newfs,"\n";
                    print $outfile "$addr1\t$lex\t$pos\t$newfs\n";
                }
                else
                {
                    print $addr1,"\t",$lex,"\t",$pos,"\t",$newfs,"\n";
                }
            }
            else
            {
                if ($output ne "")
                {
                    print $outfile $addr,"\t",$tkn,"\t",$pos,"\t",$newfs,"\n";
                }
                else
                {
                    print $addr,"\t",$tkn,"\t",$pos,"\t",$newfs,"\n";
                }
            }
        } # end if fs ne ""
        else {  # try to understand this else block

            if($lex ne "((" and $lex ne "))")
            {
                if ($output ne "")
                {
                    print $outfile $addr,"\t",$tkn,"\t",$pos,"\t",$fs,"\n";
                }
                else
                {
                    print $addr,"\t",$tkn,"\t",$pos,"\t",$fs,"\n";
                }
            }
            else {
                if ($output ne "")
                {
                    print $outfile $line."\n";
                }
                else
                {
                    print $line."\n";
                }
            }
        }


    } # end while loop
    close($infile);
    close($outfile);
}