package ILMT::TEL::HIN::ComputeVibhakti; #use strict; #use warnings; use Dir::Self; use Data::Dumper; use ILMT::TEL::HIN::SSFAPI::feature_filter; use ILMT::TEL::HIN::SSFAPI::shakti_tree_api; sub process { my %par = @_; my $input = $par{'data'}; read_story(\$input); my $keep = $par{'keep'}; my $body; my $numbody = get_bodycount(); for(my($bodynum)=1;$bodynum<=$numbody;$bodynum++) { $body = get_body($bodynum,$body); # count the number of paragraphs in the story my($numpara) = get_paracount($body); #print stderr "paras : $numpara\n"; # iterate through paragraphs in the story for(my($i)=1;$i<=$numpara;$i++) { my($para); # read paragraph $para = get_para($i); # count the number of sentences in this paragraph my($numsent) = get_sentcount($para); # iterate through sentences in the paragraph for(my($j)=1;$j<=$numsent;$j++) { # read the sentence which is in ssf format my($sent) = get_sent($para,$j); #copy vibhakti info ComputeVibhakti($sent, $keep); #compute tam ComputeTAM($sent, $keep); } } } open OUTFILE, '>', \$result or die $!; select(OUTFILE); printstory(); select(STDOUT); return $result; } sub ComputeTAM { my $sent=@_[0]; my $keep=$_[1]; my @uns_VG_nodes = &get_nodes(3,"VGF",$sent); #get all the VG nodes my @VGINF_nodes = &get_nodes(3,"VGINF",$sent); #get all the VG nodes my @VGNF_nodes = &get_nodes(3,"VGNF",$sent); #get all the VG nodes my @VGNN_nodes = &get_nodes(3,"VGNN",$sent); #get all the VG nodes #push VGINF,VGNF,VGNN nodes to uns_VG_nodes. Thus we have single list containing all the VG nodes. foreach (@VGINF_nodes) { push(@uns_VG_nodes,$_); } foreach (@VGNF_nodes) { push(@uns_VG_nodes,$_); } foreach (@VGNN_nodes) { push(@uns_VG_nodes,$_); } my @remove; my @VG_nodes = sort {$a <=> $b}(@uns_VG_nodes); #sorting list in ascending order foreach $node (@VG_nodes) { my @leaves = &get_leaves_child($node,$sent); #gets all the leaves of the the VG node my $parent = $node; my $head = 0; my $final_tam_aux = ""; my $neg = ""; $fs_array_head = ""; $verb_leaf_present = 0; my $flag=0; my @final_tam; my @_leaf; my $position=""; $f4=&get_field($node,4,$sent); #gets fs of the node my $string_fs = &read_FS($f4, $sent); my @head_value = &get_values("head", $string_fs, $sent);#gets head value of the node #checks for verb leaf, if present sets verb_leaf_present=1 foreach $leaf (@leaves) { $leaf_tag = &get_field($leaf, 3,$sent);#gets postag of leaf if($leaf_tag =~ /^V/) { $verb_leaf_present = 1; } } foreach $leaf (@leaves) { $leaf_tag = &get_field($leaf, 3,$sent);#gets postag of leaf $leaf_lex = &get_field($leaf, 2,$sent);#gets lexical item of leaf if($leaf_tag =~/^V/ and $head == 0) { $head = 1; $node_head = $leaf; $fs = &get_field($leaf, 4,$sent);#gets feature structure $fs_array = &read_FS($fs,$sent); $fs_array_head = $fs_array; @tam = &get_values("vib", $fs_array,$sent); my @name_value= &get_values("name",$fs_array,$sent); #gets value of name attribute if($head_value[0] eq $name_value[0]) { $num=$leaf-$node; #gives position of the leaf with respect to the nodei # modifies the value of vpos(position) in a chunk if($position ne "") {$position=$position."_"."tam$num";} if($position eq "") {$position="tam$num";} } #storing tam values if($tam[0] ne "") { if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".$tam[0]; } else { $final_tam_aux = $tam[0]; } #store all the tam of all interpretation in $final_tam } else { if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".0; } else { $final_tam_aux = 0; } } } elsif($leaf_tag=~/^VAUX/ or $leaf_tag=~/PSP/ or $leaf_tag=~/NST/) #identifying whether a vibhakti or not. { $flag=1; #modifying the value of vpos(position) if($position ne "") { $num=$leaf-$node; $position=$position."_".$num; } else { $position=$leaf-$node; } my $word1=&get_field($leaf,2,$sent); #gets the word(lex) #print "LEAF TAG--$leaf_tag--$word1\n"; push(@remove,$leaf); $fs = &get_field($leaf, 4,$sent); $fs_array = &read_FS($fs,$sent); @tam = &get_values("vib", $fs_array); #gets value of vib attribute @lex = &get_values("lex", $fs_array); #gets lexical item(root) push(@_leaf,$leaf); my $root = $lex[0]; my $tam_t = ""; #line 137 to 162 modifies tam feature of fs. if($tam[0] ne "" and $tam[0] ne "`" and $tam[0] ne "0" and $tam[0] ne $root) { $tam_t = $tam[0]; if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".$root."+".$tam_t; } else { $final_tam_aux = $root."+".$tam_t; } } else { $tam_t = "0"; if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".$root; } else { $final_tam_aux = $root; } } } elsif($leaf_tag eq 'NEG' and $verb_leaf_present == 1) { =cut if($position ne "") { $num=$leaf-$node; $position=$position."_"."NEG$num"; } if($position eq "") { $num=$leaf-$node; $position="NEG$num"; } $neg = &get_field($leaf, 2,$sent); push(@remove,$leaf); $flag=1; $fs = &get_field($leaf, 4,$sent); $fs_array = &read_FS($fs,$sent); @tam = &get_values("vib", $fs_array); @lex = &get_values("lex", $fs_array); push(@_leaf,$leaf); my $root = $lex[0]; my $tam_t = ""; if($tam[0] ne "" and $tam[0] ne "`" and $tam[0] ne "0" and $tam[0] ne $root) { $tam_t = $tam[0]; if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".$root."+".$tam_t; } else { $final_tam_aux = $root."+".$tam_t; } } else { $tam_t = "0"; if($final_tam_aux ne "") { $final_tam_aux = $final_tam_aux."_".$root; } else { $final_tam_aux = $root; } } =cut } } $fs_head = &get_field($parent, 4,$sent); $fs_head_array = &read_FS($fs_head,$sent); my @num,@gen,@per; #print "-->",$#_leaf,"\n"; if($#_leaf>0) { my $fs1 = &get_field($_leaf[-1], 4,$sent); my $fs2 = &get_field($_leaf[-2], 4,$sent); $fs_array1=&read_FS($fs1,$sent); $fs_array2=&read_FS($fs2,$sent); @num = &get_values("num", $fs_array1,$sent); @per = &get_values("per", $fs_array1,$sent); @gen = &get_values("gen", $fs_array2,$sent); } if($#_leaf==0) { my $fs1 = &get_field($_leaf[-1], 4,$sent); my $pos1 = &get_field($_leaf[-1], 3,$sent); if($pos1 eq "VAUX" or $pos1 eq "PSP") { $fs_array1=&read_FS($fs1,$sent); @num = &get_values("num", $fs_array1,$sent); @per = &get_values("per", $fs_array1,$sent); } } $tam_new[0] = $final_tam_aux; &update_attr_val_2("vib", \@tam_new, $fs_head_array->[0],$sent); #print "@num[0]--@per[0]--@gen[0]\n"; if(@gen[0] ne "") { &update_attr_val_2("gen", \@gen, $fs_head_array->[0],$sent); } if(@num[0] ne "") { &update_attr_val_2("num", \@num, $fs_head_array->[0],$sent); } if(@per[0] ne "") { &update_attr_val_2("per", \@per, $fs_head_array->[0],$sent); } if($verb_leaf_present == 1 and $flag==1) { $string_head = &make_string($fs_head_array,$sent); my ($x,$y)=split(/>/,$string_head); my $new_head_fs=$x." vpos=\"$position\">"; &modify_field($parent, 4, $new_head_fs,$sent); } delete @num[0..$#remove]; delete @per[0..$#remove]; delete @gen[0..$#remove]; } if (not defined $keep) { my @sort_remove=sort{$a <=> $b} @remove; my $delete=0; foreach (@sort_remove) { &delete_node($_-$delete,$sent); $delete++; } delete @remove[0..$#remove]; delete @sort_remove[0..$#remove]; } #print "after vib comp--\n"; #&print_tree(); } #the module prunes multiple feature structure (NN, NNP, PRP at present), it also removes the parsarg node in the NP and adds it to its noun fs. #$&compute_vibhakti; sub ComputeVibhakti { my $sent=@_[0]; my $keep = @_[1]; #my $delete; #keeps count of all the deleted node, helps in locating node obtained before deletion. #get all the noun nodes in the tree, the noun will be case marked '1' if a vibhakti is present, else case is '0' #my @all_leaves = &get_leaves(); #&read(@_[0]); my @all_children_NP =&get_nodes(3,"NP",$sent); #gets all the NP nodes my @all_children_RBP =&get_nodes(3,"RBP",$sent); #gets all the RBP nodes my @all_children = (@all_children_NP , @all_children_RBP); #contains all the NP and RBP nodes my @all_children = sort { $a <=> $b } @all_children; foreach $node(@all_children) { my @node_leaves=&get_leaves_child($node,$sent); #gets leaf nodes of NP or RBP node $position=""; $nhead=0; $f4=&get_field($node,4,$sent); # gets feature structure my $string_fs = &read_FS($f4, $sent); #gets head and vibhakti values my @head_value = &get_values("head", $string_fs, $sent); my @vibh_value=&get_values("vib", $string_fs, $sent); $vibh_chunk=$vibh_value[0]; #iterates through each leaf node and gets postag, word, fs foreach $NP_child(@node_leaves) { my $pos = &get_field($NP_child,3,$sent); my $word = &get_field($NP_child,2,$sent); my $fs = &get_field($NP_child,4,$sent); my $str_fs=&read_FS($fs,$sent); my @name_value=&get_values("name",$str_fs,$sent); if($pos eq "NN" or $pos eq "NNP" or $pos eq "PRP") { $nhead=1; $flag=0; $prev_RB=0; $flag_NN=1 } if($pos eq "RB") { $flag=1; $prev_RB = 1; $flag_NN=0 } if($head_value[0] eq $name_value[0]) { $num=$NP_child-$node; #gives position of the leaf with respect to the node # modifies the value of vpos(position) in a chunk if($position ne "") {$position=$position."_"."vib$num";} if($position eq "") {$position="vib$num";} } #Adds the RP vibhakti to vpos if($pos eq "RP") { if($position ne "") { $position=$position."_"."RP"; } else { next; } } if($pos eq "PSP" or $pos eq "NST" and $nhead==1) { #Adds position of vibhakti in vpos(position) value if($position ne "") { $num=$NP_child-$node; $position=$position."_".$num; } else { $position=$NP_child-$node; } my $val_fs=&get_field($NP_child, 4,$sent); $FSreference = &read_FS($val_fs,$sent); #reads feature structure of the leaf my @cur_vibhakti = &get_values("lex",$FSreference); #fetches the lexical value of vibhakti my @cur_vib_vib = &get_values("vib",$FSreference); #adds the lexical value of vibhakti to vibh_chunk if($vibh_chunk ne "") { $vibh_chunk=$vibh_chunk . "_" . $cur_vibhakti[0]; } else { $vibh_chunk="0_".$cur_vibhakti[0]; } push(@remove,$NP_child); } } if($vibh_chunk) { my @vibh_chunk_arr=(); push @vibh_chunk_arr,$vibh_chunk; #pushes the value of vibh_chunk in vibh_chunk_arr my $head_node=&get_field($node,4,$sent); my $FSreference1 = &read_FS($head_node,$sent); #gets FS value &update_attr_val("vib", \@vibh_chunk_arr,$FSreference1,$sent); #updates value of attribute vib # Modifies the value of fs by adding new attribute vpos that will be in output. my $string=&make_string($FSreference1,$sent); my ($x,$y)=split(/>/,$string); my $new_head_fs=$x." vpos=\"$position\">"; &modify_field($node,4,$new_head_fs,$sent); undef $head_word; undef $new_string; } } if (not defined $keep) { #Deletes the leaves containing vibhakti. $delete=0; foreach (@remove) { &delete_node($_-$delete,$sent); $delete++; } delete @remove[0..$#remove]; } } 1;