diff --git a/lib/ILMT/KAN/HIN.pm b/lib/ILMT/KAN/HIN.pm index fe16c4120eab44c815e3591745e4fdfc3947eb33..1e8fb08dcb72a31743c40d80075f7509043da92f 100644 --- a/lib/ILMT/KAN/HIN.pm +++ b/lib/ILMT/KAN/HIN.pm @@ -15,7 +15,6 @@ my @seq = ( "PickOneMorph", "Repair", "ComputeHead", - "ComputeVibhakti", "WX2UTF" ); diff --git a/modules/ILMT-KAN-HIN-ComputeVibhakti/.gitmodules b/modules/ILMT-KAN-HIN-ComputeVibhakti/.gitmodules deleted file mode 100755 index e415bda26816a7b38b8b33cf034296feddee4f78..0000000000000000000000000000000000000000 --- a/modules/ILMT-KAN-HIN-ComputeVibhakti/.gitmodules +++ /dev/null @@ -1,3 +0,0 @@ -[submodule "API"] - path = API - url = https://gitlab.com/ilmt/ILMT-TEL-HIN-SSFAPI.git diff --git a/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/feature_filter.pm b/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/feature_filter.pm deleted file mode 100755 index 2eb368104205b0c620508bd30ff9a59cb4c27189..0000000000000000000000000000000000000000 --- a/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/feature_filter.pm +++ /dev/null @@ -1,1197 +0,0 @@ -package ILMT::KAN::HIN::SSFAPI::feature_filter; - -use Exporter qw(import); - -our @EXPORT = qw( - read_FS convert_to_old read_FS_old get_values get_values_2 - get_attributes get_path_values get_path_values_2 copyFS add_attr_val - add_attr_val_2 update_attr_val update_attr_val_2 del_attr_val - del_attr_val_2 unify unify_2 merge merge_2 load_hash printFS_SSF - printFS_SSF_2 make_string make_string_2 prune_FS prune_FS_2 - get_fs_reference get_num_fs printFS_SSF_old make_string_old); - -# P.NIRUPAM PRATAP REDDY -# 200101050 (UG3) -# MODIFIED BY: Samar Husain (samar@research.iiit.ac.in) -# NOTE: Feature Path from the beginning has to specified as follows, a1.a2.a3.a4 (etc) - -#% read_FS($string) --> reference to an or array. -#% Pass a string which is the feature structure to be loaded and -#% a reference to an or array is returned. -# -# -my $ref_to_fs = read_FS("< fs af='xe,v,f,s,any,,ne,yA' drel=k1:1|k2 vibh=ne|ko|se >"); -my @fff = get_values("lex", $ref_to_fs); - -#print stderr $fff[0]."\n"; -my $new_fs = make_string($ref_to_fs); -#print stderr "NEW=$new_fs\n"; - - -sub read_FS -{ - local (@_STRING_,$_INDEX_); - my $featureString=$_[0]; - - #temporary - $featureString = convert_to_old($featureString); - - $featureString=~s/af=(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?)([\/>])/lex=$1\/cat=$2\/gen=$3\/num=$4\/per=$5\/cas=$6\/vib=$7\/tam=$8$9/g; - - $featureString="< ROOT = ".$featureString." >"; - @_STRING_= split(//,$featureString); - - $_INDEX_=0; - my %hashRef; - $hashRef=load_hash(); - return $$hashRef{'ROOT'}; -} - -#the module takes the new xml format and converts it to the old one, -#this seems to be a temporary solution, -#like this only the printer needs to be modified, everything remains same. -sub convert_to_old -{ - my $col_fs = $_[0]; -# print stderr "Original: $col_fs\n"; - - #remove 'fs ' - $col_fs =~ s/\s*fs\s+//g; - #remove single quotes - $col_fs =~ s/'//g; - #Remove '/'. Stupid hack, but required so that it doesn't conflict with the delimiter in SSF parsing. - $col_fs =~ s/\///g; - #take care of any spaces before the closing angular brace, if any - $col_fs =~ s/\s*>/>/g; - #convert all the spaces into backspaces, this assumes that there can - #be no space between attribute=value pair. - $col_fs =~ s/\s+/\//g; -# print stderr "Converted: $col_fs\n\n\n"; - return $col_fs; -} - -#% read_FS($string) --> reference to an array -#% Pass a string which is the feature structure to be loaded and -#% - -sub read_FS_old -{ - local (@_STRING_,$_INDEX_); - my $featureString=$_[0]; - my $featureStructure; - - @array=split(/\/\//,$featureString); - - for($i=0;$i<@array;$i++) - { - $array[$i]=~s/(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?)(\|.*)/af=$1,$2,$3,$4,$5,$6,$7,$8$9/; - $array[$i]=~s/\|/\//g; - $array[$i]=~s/\/$/>/g; - $array[$i]="<".$array[$i]; - $array[$i]=~s/[\'\"]//g; - $featureStructure.="|".$array[$i]; - } - $featureStructure=~s/^\|<\|//g; - $featureStructure=~s/\/\s*$/>/g; - my $ref=read_FS($featureStructure); - my $newString=""; - return $ref; -} - -#% get_values($featurePath,$FSreference) --> An array containg the matched values. -#% $FSreference is the OR containing an or node with a collection of a number of possible Feature Structures. -#% The array that is returned can contain both values as well as reference to other featurestructures. -#% The returned array is an OR array. - -sub get_values -{ - my $featurePath=$_[0]; - my $arrayRef=$_[1]; - $featurePath="ROOT.".$featurePath; - my %hash; - $hash{'ROOT'}=$arrayRef; - - my @ReturnedArray; - #@ReturnedArray=get_values_hash($featurePath,\%hash); - return get_values_2($featurePath,\%hash); - #return @ReturnedArray; -} - -#% get_values_2($featurePath,$FSreference) --> An array containg the matched values. -#% $FSreference is the reference to a single feature structure. -#% The array that is returned can contain both values as well as reference to other featurestructures. -#% The returned array is an OR array. - -sub get_values_2 -{ - #Feature path is given as follows: - #a1.a2.a3..... - - my $featurePath=$_[0]; - my $hashRef=$_[1]; - my ($presAttr,$nextPath); - - if($featurePath=~/\./) - { - $presAttr=$`; - $nextPath=$'; - } - else - { $presAttr=$featurePath; } - - - if($nextPath eq "") - { - my $arrayRef=$$hashRef{$presAttr}; - my @newReturnArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $newReturnArray[$i]=copyFS($$arrayRef[$i]); - } - else - { - $newReturnArray[$i]=$$arrayRef[$i]; - } - } - return @newReturnArray; - #return @$arrayRef; # Return the array - } - else - { - my $arrayRef=$$hashRef{$presAttr}; - my @RetArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - push(@RetArray,get_values_2($nextPath,$$arrayRef[$i])); - } - } - - return @RetArray; - } -} - -#% get_attributes($FSReference) -> array containing the attributes for that feature structure -#% $FSReference is the reference to a hash (that is that of a single feature structue) NOT of a or node (i.e a collection) -#% of feature structures. -#% - -sub get_attributes -{ - my $hashRef=$_[0]; - my @attributes=keys(%$hashRef); - my @differentArray,$j=0; - my $numberOfAttributes=@attributes; - for(my $i=0;$i<$numberOfAttributes;$i++) - { - if(defined($$hashRef{$attributes[$i]})) - { - $differentArray[$j]=$attributes[$i]; - $j++; - } - } - return @differentArray; -} - -#% get_path_values($attr,$fs) --> 2D array of values and paths. -#% $fs is the reference to an or node with more than one Feature Structures in it. -#% field 0 contains the path -#% field 1 contains the value. - -sub get_path_values -{ - my $attr=$_[0]; - my $arrayRef=$_[1]; - - my %hash; - $hash{'ROOT'}=$arrayRef; - my @retArray; - @retArray=get_path_values_2($attr,\%hash); - - for(my $i=0;$i<@retArray;$i++) - { - $retArray[$i][0]=~s/^\.ROOT\.//g; - } - return @retArray; -} - -#% get_path_values_2($attr,$fs) --> 2D array of values and paths. -#% $fs is the reference to a single feature structure. -#% field 0 contains the path -#% field 1 contains the value. - -sub get_path_values_2 -{ - my $attr=$_[0]; - my $hashRef=$_[1]; - my $path=$_[2]; - my $key; - my @keys=keys(%$hashRef); - my @RetArray; - my $count=0; - - - foreach $key(@keys) - { - my $newPath=$path.".".$key; - - if($key eq $attr) - { - my $arrayRef=$$hashRef{$key}; - my @newArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $newArray[$i]=copyFS($$arrayRef[$i]); - my @toPushArray; - @toPushArray=get_path_values_2($attr,$$arrayRef[$i],$newPath); - for(my $i=0;$i<@toPushArray;$i++) - { - $RetArray[$count][0]=$toPushArray[$i][0]; - $RetArray[$count][1]=$toPushArray[$i][1]; - $count++; - } - } - else - { - $newArray[$i]=$$arrayRef[$i]; - } - } - - $RetArray[$count][0]=$newPath; - $RetArray[$count][1]=\@newArray; - $count++; - } - else - { - my $arrayRef=$$hashRef{$key}; - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $newArray[$i]=copyFS($$arrayRef[$i]); - my @toPushArray; - @toPushArray=get_path_values_2($attr,$$arrayRef[$i],$newPath); - for(my $i=0;$i<@toPushArray;$i++) - { - $RetArray[$count][0]=$toPushArray[$i][0]; - $RetArray[$count][1]=$toPushArray[$i][1]; - $count++; - } - } - } - } - } - - return @RetArray; -} - -#% copyFS($fs) --> Reference of a new FS -#% Copies fs into a new fs and returns that. - -sub copyFS -{ - my $hashRef=$_[0]; - my %newHash; - my @referenceKeys=keys(%$hashRef); - my $key; - - foreach $key(@referenceKeys) - { - my $arrayRef=$$hashRef{$key}; - my @newArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $newArray[$i]=copyFS($$arrayRef[$i]); - } - else - { - $newArray[$i]=$$arrayRef[$i]; - } - } - - $newHash{$key}=\@newArray; - } - - return \%newHash; -} - -#% add_attr_val($featurePath,$value,$FSReference) --> -nil- -#% FSReference is an or node containing multiple possible feature structures. -#% $value is a reference to an OR array. The values in the array will be either normal strings or references to other -#% featurestructures (hashes) - -sub add_attr_val -{ - my $featurePath=$_[0]; - my $val=$_[1]; - my $arrayRef=$_[2]; - my %hash; - $featurePath="ROOT.".$featurePath; - $hash{'ROOT'}=$arrayRef; - add_attr_val_2($featurePath,$val,\%hash); - - return; -} - -#% add_attr_val_2($featurePath,$value,$FSReference) --> -nil- -#% $value is a reference to an OR array. The values in the array will be either normal strings or references to other -#% featurestructures (hashes) - -sub add_attr_val_2 -{ - my $featurePath=$_[0]; - my $val=$_[1]; # This value has to be a reference to an array. - my $hashRef=$_[2]; # That array will contain either the references to other - my ($presAttr,$nextPath); - - if($featurePath=~/\./) - { - $presAttr=$`; - $nextPath=$'; - } - else - { $presAttr=$featurePath; } - - - if($nextPath eq "") - { - my $arrayRef=$$hashRef{$presAttr}; - if(defined($arrayRef)) - { - my $prevNumber=@$arrayRef; - for(my $i=0;$i<@$val;$i++) - { - if(ref($$val[$i]) eq "HASH") - { - $$arrayRef[$i+$prevNumber]=copyFS($$val[$i]); - } - else - { - $$arrayRef[$i+$prevNumber]=$$val[$i]; - } - } - } - else - { - my @arrayAdd; - - for(my $i=0;$i<@$val;$i++) - { - if(ref($$val[$i]) eq "HASH") - { - $$arrayAdd[$i]=copyFS($$val[$i]); - } - else - { - $arrayAdd[$i]=$$val[$i]; - } - } - $$hashRef{$presAttr}=\@arrayAdd; - } - return; - } - else - { - my $arrayRef=$$hashRef{$presAttr}; - if(defined($arrayRef)) - { - my $entered=0; - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $entered=1; - $arrayRef[$i]=add_attr_val_2($nextPath,$val,$$arrayRef[$i]); - } - } - - if($entered==0) - { - my %hash; - my @arrayAdd; - $arrayAdd[0]=\%hash; - push(@$arrayRef,@arrayAdd); - add_attr_val_2($nextPath,$val,$arrayAdd[0]); - } - return; - } - else - { - my %hash; - my @arrayAdd; - $arrayAdd[0]=\%hash; - $$hashRef{$presAttr}=\@arrayAdd; - add_attr_val_2($nextPath,$val,\%hash); - } - } -} - -#% update_attr_val($featurePath,$val,$FSReference) --> -nil- -#% FSReference is the OR Node reference -#% The value in the featurepath specified will be changed to the new val. -#% If that val is not present then it is added. - -sub update_attr_val -{ - my $featurePath=$_[0]; - my $val=$_[1]; # This value has to be a reference to an array. - my $arrayRef=$_[2]; # That array will contain either the references to other - $featurePath="ROOT.".$featurePath; - my %hash; - $hash{'ROOT'}=$arrayRef; - - update_attr_val_2($featurePath,$val,\%hash); - return; -} - -#% update_attr_val_2($featurePath,$val,$FSReference) --> -nil- -#% The value in the featurepath specified will be changed to the new val. -#% If that val is not present then it is added. - -sub update_attr_val_2 -{ - my $featurePath=$_[0]; - my $val=$_[1]; # This value has to be a reference to an array. - my $hashRef=$_[2]; # That array will contain either the references to other - my ($presAttr,$nextPath); - - if($featurePath=~/\./) - { - $presAttr=$`; - $nextPath=$'; - } - else - { $presAttr=$featurePath; } - - - if($nextPath eq "") - { - if(defined($$hashRef{$presAttr})) # Update an existing value. - { - my @arrayAdd; - - for(my $i=0;$i<@$val;$i++) - { - if(ref($$val[$i]) eq "HASH") - { - $arrayAdd[$i]=copyFS($$val[$i]); - } - else - { - $arrayAdd[$i]=$$val[$i]; - } - } - - $$hashRef{$presAttr}=\@arrayAdd; - } - } - else - { - my $arrayRef=$$hashRef{$presAttr}; - my @RetArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - update_attr_val_2($nextPath,$val,$$arrayRef[$i]); - } - } - - return; - } -} - -#% del_attr_val($featurePath,$FSReference) -#% FSReference is the OR node reference -#% Deletes the value in the attribute specified by the path. - -sub del_attr_val -{ - my $featurePath=$_[0]; - my $arrayRef=$_[1]; - $featurePath="ROOT.".$featurePath; - my %hash; - $hash{'ROOT'}=$arrayRef; - del_attr_val_2($featurePath,\%hash); -return; -} - -#% del_attr_val_2($featurePath,$FSReference) -#% Deletes the value in the attribute specified by the path. - -sub del_attr_val_2 -{ - my $featurePath=$_[0]; - my $hashRef=$_[1]; - my ($presAttr,$nextPath); - - if($featurePath=~/\./) - { - $presAttr=$`; - $nextPath=$'; - } - else - { $presAttr=$featurePath; - } - - if($nextPath eq "") - { - if(defined($$hashRef{$presAttr})) # Undefine an already existing value. - { - delete $$hashRef{$presAttr}; #changed from undef to delete 15th Dec 2004 - #undef($$hashRef{$presAttr}); - } - - ######### Changed 19th Feb 2004 03:05 - if($$hashRef{$presAttr}=~/^\s*$/) - { - delete $$hashRef{$presAttr}; #changed from undef to delete 15th Dec 2004 - #undef($$hashRef{$presAttr}); - } - } - else - { - my $arrayRef=$$hashRef{$presAttr}; - #my @RetArray; - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - del_attr_val_2($nextPath,$$arrayRef[$i]); - } - } - - return; - } -} - -#% unify($fs1,$fs2) --> $fs3; -#% $fs1 and $fs2 are references to two or nodes possibly containing one or more feature structures, -#% But there should not be multiple possible feature Structures given to it. That or node should contain only one possible -#% feature structure. -#% $fs3 is either -1 or a reference to a new or node of feature structures. -#% -1 is returned in the case that the featurestructures cannot be unified. - -sub unify -{ - my $firstRef=$_[0]; - my $secondRef=$_[1]; - my (%hash1,%hash2,$hashRef); - - $hash1{'ROOT'}=$firstRef; - $hash2{'ROOT'}=$secondRef; - - $hashRef=unify_2(\%hash1,\%hash2); - if($hashRef!=-1) - { - return $$hashRef{'ROOT'}; - } - else - { - return -1; - } -} - -#% unify_2($fs1,$fs2) --> $fs3; -#% $fs1 and $fs2 are references to two feature structures -#% $fs3 is either -1 or a reference to a new feature structure. -#% -1 is returned in the case that the featurestructures cannot be unified. - -sub unify_2 -{ - my $firstRef=$_[0]; - my $secondRef=$_[1]; - my @keys1=keys(%$firstRef); - my @keys2=keys(%$secondRef); - my $key; - my %hash; - - foreach $key(@keys1) - { - my $valArrayRef1=$$firstRef{$key}; - my $valArrayRef2=$$secondRef{$key}; - my $retVal; - - if(@$valArrayRef1>1 or @$valArrayRef2>1) - { - print "#RULE NOT DEFINED TO MERGE THE VALUES\n"; - return -1; - } - else - { - if(ref($$valArrayRef1[0]) eq "HASH" and ref($$valArrayRef2[0]) eq "HASH") - { - $retVal=unify_2($$valArrayRef1[0],$$valArrayRef2[0]); - - if($retVal!=-1) - { - my @array; - $array[0]=$retVal; - $hash{$key}=\@array; - } - else - { - return -1; - } - } - elsif((not(ref($$valArrayRef1[0]) eq "HASH")) and (not(ref($$valArrayRef2[0]) eq "HASH"))) - { - if(defined($$valArrayRef1[0]) and defined($$valArrayRef2[0])) - { - if($$valArrayRef1[0] eq $$valArrayRef2[0]) - { - my @array; - $array[0]=$$valArrayRef1[0]; - $hash{$key}=\@array; - } - else - { - return -1; - } - } - else - { - # If anything is not defined here it will be $$valArrayRef2[0] - # Because we are considering the keys of ref1 - my @array; - $array[0]=$$valArrayRef1[0]; - $hash{$key}=\@array; - } - } - elsif(not(defined($$varArrayRef2[0]))) - { - my @array; - $array[0]=$$valArrayRef1[0]; - $hash{$key}=\@array; - } - else - { - return -1; - } - } - } - - foreach $key(@keys2) - { - my $valArrayRef2=$$secondRef{$key}; - - if(not(defined($$firstRef{$key}))) - { - my $arrayRef=$$secondRef{$key}; - my @arrayAdd; - for(my $i=0;$i<@$arrayRef;$i++) - { - if(not(ref($$arrayRef[$i]) eq "HASH")) - { $arrayAdd[$i]=$$arrayRef[$i]; } - else - { - $arrayAdd[$i]=copyFS($$arrayRef[$i]); - } - } - $hash{$key}=\@arrayAdd; - } - } - - return \%hash; -} - -#% merge($fs1,$fs2) --> -nil- -#% $fs1 and $fs2 are or nodes containing multiple possible feature structures. -#% Changes all the values of fs1 to that of fs2 for all the common attributes in fs1 and fs2 -#% Rest of the values are left untouched. - -sub merge -{ - my $firstRef=$_[0]; - my $secondRef=$_[1]; - my (%hash1,%hash2); - - merge_2($$firstRef[0],$$secondRef[0]); - return; -} - -#% merge_2($fs1,$fs2) --> -nil- -#% Changes all the values of fs1 to that of fs2 for all the common attributes in fs1 and fs2 -#% Rest of the values are left untouched. - -sub merge_2 -{ - my $firstRef=$_[0]; - my $secondRef=$_[1]; - my $key; - my @keys2=keys(%$secondRef); - - foreach $key(@keys2) - { - undef($$firstRef{$key}); - my $arrayRef=$$secondRef{$key}; - my @newArray; - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $newArray[$i]=copyFS($$arrayRef[$i]); # Change the value of one to that in two. - } - else - { - $newArray[$i]=$$arrayRef[$i]; - } - } - - $$firstRef{$key}=\@newArray; - -# But the users have to be careful here as there is just a swap of references and not a complete copy of the values. - } - - return; -} - -#% load_hash -#% Loads the string passed to a hash and the reference to that hash is returned. - -sub load_hash -{ - if($_STRING_[$_INDEX_] ne "<") - { - my $value; - - while($_STRING_[$_INDEX_] ne "|" and $_STRING_[$_INDEX_] ne "/" and $_STRING_[$_INDEX_] ne ">") # Go on till you find a / or | - { - $value.=$_STRING_[$_INDEX_]; - $_INDEX_++; - - while($_STRING_[$_INDEX_]=~/\s+/) #Ignore all the spaces. - { $_INDEX_++; } - } - # Stop at the / or the final position. Do not go beyond that. - return $value; # Return the final value. - } - else - { - my %hash; - $_INDEX_++; # Leave the { behind. - - while($_STRING_[$_INDEX_] ne ">") - { - my $attr; - my @arrayVal; - my $arrayMarker=0; - - if($_STRING_[$_INDEX_] eq "/") - { $_INDEX_++; } - - while($_STRING_[$_INDEX_]=~/\s+/) - { $_INDEX_++; } - - - while($_STRING_[$_INDEX_] ne "=") - { - $attr.=$_STRING_[$_INDEX_]; - $_INDEX_++; - - while($_STRING_[$_INDEX_]=~/\s+/) #Ignore all the spaces. - { $_INDEX_++; } - - } - $_INDEX_++; # This is to throw out the = - - while($_STRING_[$_INDEX_]=~/\s+/) #Ignore all the spaces. - { $_INDEX_++; } - - while(1) # Continue until the loop breaks. - { - $arrayVal[$arrayMarker]=load_hash(); - - while($_STRING_[$_INDEX_]=~/\s+/) - { - $_INDEX_++; # Remove any spaces following the ending of a pair. - } - - $arrayMarker++; - - if($_STRING_[$_INDEX_] eq "/" or $_STRING_[$_INDEX_] eq ">") - { last; } - elsif($_STRING_[$_INDEX_] eq "|") - { - $_INDEX_+=1; #Get beyond that mark. - - while($_STRING_[$_INDEX_]=~/\s+/) #Ignore all the spaces. - { $_INDEX_++; } - } - else - { print "ERROR: $_STRING_[$_INDEX_]"; } - } - $hash{$attr}=\@arrayVal; - } - $_INDEX_++; - return \%hash; - } -} - -#% printFS_SSF($fs) --> -nil- -#% $fs is a reference to an or node containing multiple possible feature structures. -#% prints the attributes and values present in the hash in the standard format. - -sub printFS_SSF -{ - my $arrayRef=$_[0]; - my $finalString; - - $finalString=make_string($arrayRef); - print "$finalString\n"; -} - -#% printFS_SSF_2($fs) --> -nil- -#% $fs is a reference to a single possible feature structure. -#% prints the attributes and values present in the hash in the standard format. - -sub printFS_SSF_2 -{ - my $finalString; - my $FSRef=$_[0]; - $finalString=make_string_2($FSRef); - print "$finalString \n"; -} - -#% make_string($FSReference) --> -$string- -#% $FSReference is the array reference returned by the read_FS function. -#% $stringRef is reference to a string into which you want to get the string. - -sub make_string -{ - my $arrayRef=$_[0]; - my $string; - - - for(my $i=0;$i<@$arrayRef;$i++) - { - $string.=make_string_2($$arrayRef[$i])."|"; - } - - $string=~s/\|$//g; - $string=~s/\'\"/\"/g; # Litha Changes - $string=~s/\"\'/\"/g; # Litha Changes -# if($string eq "<>") - if($string eq "<'>") - { - undef($string); - } - return $string; -} - -sub make_string_2 -{ - my $hashRef=$_[0]; - my @keyValues; - my $key; -# my $refString=$_[1]; - my $String; - my ($string,@array); - @array=('lex','cat','gen','num','per','cas','vib','tam'); - - my $present=1; - - foreach $string(@array) - { - if(not(defined($$hashRef{$string}))) - { $present=0;last; } - } - - @keyValues=keys(%$hashRef); - if($present eq 1) - { - #$String.="8) - { - #$String.="/"; - $String.="' "; - } - } - } - } - else - { - $String.="<"; - } - - my $count=0; - - for($key=0;$key<@keyValues;$key++) - { - my $arrayRef; - $arrayRef=$$hashRef{$keyValues[$key]}; - - if($keyValues[$key] ne "ROOT") - { - my $attr=$keyValues[$key]; - - if($attr eq "lex" or $attr eq "cat" or $attr eq "gen" or $attr eq "num" or $attr eq "per" or $attr eq "cas" or $attr eq "vib" or $attr eq "tam") - { - $count++; - next; - } - - if(defined($$hashRef{$keyValues[$key]})) - { - $String.=$keyValues[$key]."='"; # Litha Changes - } - else - { - next; - } - } - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - $String.=make_string_2($$arrayRef[$i]); - } - else - { - $String.=$$arrayRef[$i]; - } - - if($i+1<@$arrayRef) - { - $String.="|"; - } - } - - - if($key+1<@keyValues && 8-$count!=@keyValues-$key-1) - { - my $num=@keyValues; - #$String.="/"; - $String.="' "; # Litha Changes - } - } - - #if($String[@String]=='/') { - # chop($String); - # print "\nY\n"; - #} - if($String =~ /'.*'/) # If the FS has more than 8 default fields then no need of "'" else add it. - { - $String.="'>"; # Litha Changes - } - else - { - $String.="'>"; - } - return $String; -} - -#% prune_FS($featurePath,$fieldNumber,$FSReference) --> +1/-1 -#% Deletes the value in the attribute specified by the path. -#% +1 indicates successful completion of the function -#% -1 indicates that such a feature path does not exist. - -sub prune_FS -{ - my $featurePath=$_[0]; - my $fieldNumber=$_[1]; - my $arrayRef=$_[2]; - - $featurePath="ROOT.".$featurePath; - my %hash; - $hash{'ROOT'}=$arrayRef; - return prune_FS_2($featurePath,$fieldNumber,\%hash); -} - - -#% prune_FS_2($featurePath,$fieldNumber,$FSReference) --> +1/-1 -#% Deletes the value in the attribute specified by the path. -#% +1 indicates successful completion of the function -#% -1 indicates that such a feature path does not exist. - -sub prune_FS_2 -{ - my $featurePath=$_[0]; - my $fieldNumber=$_[1]; - my $hashRef=$_[2]; - my ($presAttr,$nextPath); - - if($featurePath=~/\./) - { - $presAttr=$`; - $nextPath=$'; - } - else - { $presAttr=$featurePath; } - - - if($nextPath eq "") - { -=s - if(defined($$hashRef{$presAttr})) # Undefine an already existing value. - { undef($$hashRef{$presAttr}); } -=cut - my $hashValue=$$hashRef{$presAttr}; - if($hashValue ne "") - { - my $numEle,$arrayRef; - $arrayRef=$$hashRef{$presAttr}; - $numEle=@$arrayRef; - for(my $i=$fieldNumber;$i<$numEle-1;$i++) - { - $$arrayRef[$i]=$$arrayRef[$i+1]; - } - pop(@$arrayRef); # pop the final one which is left out. - - $numEle=@$arrayRef; - if($numEle==0) - { - undef($$hashRef{$presAttr}); - } - - return 1; - } - else - { - return -1; - } - } - else - { - my $arrayRef=$$hashRef{$presAttr}; - my @RetArray; - - if(not(defined($$hashRef{$presAttr}))) - { - return -1; - } - - for(my $i=0;$i<@$arrayRef;$i++) - { - if(ref($$arrayRef[$i]) eq "HASH") - { - prune_FS_2($nextPath,$fieldNumber,$$arrayRef[$i]); - } - } - - return 1; - } - -} - -#% get_fs_reference($ref_to_array,$index_feature_structure) -#% $ref_to_array is the reference to an OR array -#% $index_... is field you want from the array. -#% - -sub get_fs_reference -{ - my $refArray=$_[0]; - my $index=$_[1]; - - return $$refArray[$index]; -} - -#% get_num_fs($ref_to_array) --> number of feature structures (Or values also) -#% - -sub get_num_fs -{ - my $refArray=$_[0]; - my $number=@$refArray; - - return $number; -} -#% printFS_SSF($fs) --> -nil- -#% $fs is a reference to an or node containing multiple possible feature structures. -#% prints the attributes and values present in the hash in the standard format. - -sub printFS_SSF_old -{ - my $arrayRef=$_[0]; - my $finalString; - # In the old format we do not have nested feature structures inside the bigger feature structures. - - $finalString=make_string($arrayRef); - my $featureStructure; - - - my @array=split(/\|/,$finalString); - - for(my $i=0;$i<@array;$i++) - { - $array[$i]=~s/^$/\|/g; - $array[$i]=~s/\//\|/g; - $array[$i]=~s/af=(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?)([\|>])/\/\/$1,$2,$3,$4,$5,$6,$7,$8$9/; - $array[$i]=~s/=(.*?)\|/=$1\|/g; - $featureStructure.=$array[$i]; - } - print "$featureStructure\n"; -} - -sub make_string_old -{ - my $arrayRef=$_[0]; - my $finalString; - # In the old format we do not have nested feature structures inside the bigger feature structures. - - $finalString=make_string($arrayRef); - my $featureStructure; - - - my @array=split(/\|/,$finalString); - - for(my $i=0;$i<@array;$i++) - { - $array[$i]=~s/^$/\|/g; - $array[$i]=~s/\//\|/g; - $array[$i]=~s/af=(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?),(.*?)([\|>])/\/\/$1,$2,$3,$4,$5,$6,$7,$8$9/; - $array[$i]=~s/=(.*?)\|/=$1\|/g; - $featureStructure.=$array[$i]; - } - - return $featureStructure; -} - -# Report any bugs to -# p_nirupam@students.iiit.net -# (or) sriram@students.iiit.net - -1; diff --git a/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/shakti_tree_api.pm b/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/shakti_tree_api.pm deleted file mode 100755 index c2fdc1f9b666e9f4eb10b16f16eb058381d3e45e..0000000000000000000000000000000000000000 --- a/modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/shakti_tree_api.pm +++ /dev/null @@ -1,1604 +0,0 @@ -package ILMT::KAN::HIN::SSFAPI::shakti_tree_api; - -use Exporter qw(import); - -our @EXPORT = qw( - read_story printsentence get_paracount get_bodycount get_body get_para - get_sentcount get_sent print_para print_pararef printstory - printstory_file copy_story read assign_reach print_tree print_tree_file - assign_readable_numbers reorder_numbers print_node get_children - get_leaves get_leaves_child get_nodes get_nodes_pattern delete_node - create_parent delete_layer create_tree add_tree add_node get_fields - get_field modify_field copy move_node copy_tree get_parent - get_next_node get_previous_node add_leaf change_old_new change_new_old - delete_tree); - -# P.NIRUPAM PRATAP REDDY -# UG3 -# 200101050 - -# Modified by Samar Husain -# email: samar@research.iiit.net -# - -#!/usr/bin/perl -#my $vibh_home = $ENV{'VIBHAKTI_HOME'}; -#require "$vibh_home/API/feature_filter.pl"; -#$SSF_API = $ENV{'SSF_API'}; - -#require "$SSF_API/feature_filter.pl"; - -# SSF is represented using a 2D-Array . -# The entire tree is loaded into @_TREE_ -# Rows of array = Lines of the textual format -# Columns of array = Field Numbers ( Field-0 to Field-4) -# $tree = Memory Structure -# $node = Index of a node -#----------------------------------------------------------------------------- - -#% Reads the entire story into the data structure @_Story_ -#% This @_Story_ in turn consists of an array reference -#% hich corresponds to paragraph; this paragraph -#% will have various sentences (for this we call the basic read()) -#% Each of these arrays' zeroth element contains the total element count in the array. -#% read_story($filename) -#% - -sub read_story -{ - @_Story_ = (); - - my $line_count = 0; - my $sentnum = 0; - my $storyname; - my $first_l,$second_l,$third_l,$last_line,$meta; - - $storyname = $_[0]; - - open(IN, '<', $storyname) or die ("Could not open the file $storyname to read\n"); - - my @all_lines = ; - - for(my $i = 0; $i < scalar(@all_lines); $i++) - { - chomp($all_lines[$i]); - - # Litha Changes upto end of for loop - # All if loop can be change to if else and some - #variables(like visible,flags etc) are used - - if($all_lines[$i] =~ /xml\sversion/) - { - $first_l = $all_lines[$i]."\n\n"; - $count++; - } - elsif($all_lines[$i] =~ /DOCTYPE\sdocument/) - { - $second_l = $all_lines[$i]."\n\n"; - $count++; - } - elsif($all_lines[$i] =~ /") - { - $metaf = 1; - $meta = ""; - $meta = $meta."$all_lines[$i]\n"; - $count++; - } - elsif($all_lines[$i] eq "") - { - $meta = $meta."$all_lines[$i]\n\n"; - $metaf = 0; - } - elsif($metaf == 1) - { - $meta = $meta."$all_lines[$i]\n"; - } - elsif($all_lines[$i] eq "") - { - $bodyf = 1; - $body_num++; - $_Story_[$body_num]->[0]->{'body_visible'}=1; - $count++; - } - elsif($all_lines[$i] eq "") - { - $_Story_[$body_num]->[0]->{'num_para'} = $pnum; - $bodyf = 0; - $pnum = 0; - } - elsif($all_lines[$i]=~m/\/) - { - if($bodyf==0) - { - $bodyf =1; - $body_num++; - $_Story_[$body_num]->[0]->{'body_visible'}=0; - } - - $pnum++; - $_Story_[$body_num]->[$pnum]->[0]->{'para_visible'}=1; - # Sriram Changes - $_Story_[$body_num]->[$pnum]->[0]->{'number'} = $1; - $_Story_[$body_num]->[$pnum]->[0]->{'segment'} = $2; - $_Story_[$body_num]->[$pnum]->[0]->{'bullet'} = $3; - $count++; -#print STDERR "TB Number $pnum \n"; - - - $pf=1; - } - elsif($all_lines[$i] eq "") - { - # Original Statement - # $_Story_[$body_num][$pnum]->[0] = $sentnum; - # Sriram Changes - $_Story_[$body_num][$pnum]->[0]->{'numSens'} = $sentnum; - - $pf = 0; - $sentnum = 0; - - } - elsif($input=~m/[ ]+\<\/foreign\>/){ - # Sriram Changes - $_Story_[$body_num][$pnum]->[0]->{'language'} = $1; - $_Story_[$body_num][$pnum]->[0]->{'writingsystem'} = $2; - $count++; - $pnum++ - } - elsif($all_lines[$i] =~ //) - { - if($pf == 0) - { - $bodyf=1; - $body_num++; - $_Story_[$body_num]->[0]->{'body_visible'}=0; - $pf=1; - $pnum++; - $_Story_[$body_num]->[$pnum]->[0]->{'para_visible'}=0; - } - $_Story_[$body_num]->[$pnum]->[0]->{'text_visible'}=1; - $textf=1; - $count++; - } - elsif($all_lines[$i] =~ /[0]->{'body_visible'}=0; - $pf=1; - $pnum++; - $_Story_[$body_num]->[$pnum]->[0]->{'para_visible'}=0; - $textf =1; - $_Story_[$body_num]->[$pnum]->[0]->{'text_visible'}=0; - } - $sentf = 1; - $cur_sent_id = $1; - $sentnum++; - $count++; - $_Story_[$body_num]->[$pnum]->[0]->{'sent_visible'}=1; - - $_Story_[$body_num]->[$pnum]->[0]->{'sent_Ids'}->[$sentnum] = $cur_sent_id; - - # Litha Changes - # Orignal Statement - # open(OUT, ">tmp/sentSSF.$$") or die("could not open to write\n"); - delete @sent[0..$#sent]; - my @sent; - my $j = 0; - } - elsif($all_lines[$i] =~ /<\/Sentence>/) - { - # Litha Changes - # Orignal Statement - #close(OUT); - - my($tRee); - # Litha Changes - # Orignal Statement - #$tRee = read("tmp/sentSSF.$$"); - $tRee = __PACKAGE__->can('read')->(\@sent); - my $dub_tree = copy_tree($tRee); - $_Story_[$body_num]->[$pnum]->[$sentnum] = $dub_tree; - $_Story_[$body_num]->[$pnum]->[0]->{'numSens'} = $sentnum; - } - elsif($all_lines[$i] =~ /<\/text>/) - { - $_Story_[$body_num]->[$pnum]->[0]->{'numSens'} = $sentnum; - $textf=0; - } - else - { - if(($sentf == 0) && ($count == 0) && ($all_lines[$i] ne "")) - { - $bodyf = 1; - $body_num++; - $_Story_[$body_num]->[0]->{'body_visible'}=0; - $pf=1; - $pnum++; - $_Story_[$body_num]->[$pnum]->[0]->{'para_visible'}=0; - $sentf =1; - $sentnum++; - $_Story_[$body_num]->[$pnum]->[0]->{'sent_visible'}=0; - $_Story_[$body_num]->[$pnum]->[0]->{'text_visible'}=0; - $textf=1; - # Litha Changes - # Orignal Statement - # open(OUT, ">tmp/sentSSF.$$") or die("could not open to write\n"); - delete @sent[0..$#sent]; - my @sent; - my $j = 0; - $sentflag = 1; - $count++; - } - #$all_lines[$i]=~s/([\t]+)$/$1<>/g; - # Litha Changes - # Orignal Statement - # print OUT "$all_lines[$i]\n"; - @sent[$j++]= "$all_lines[$i]\n"; - } - - } - # Litha Changes - - if($sentflag) - { - # Litha Changes - # Orignal Statement - # close(OUT); - - my($tRee); - # Litha Changes - # Orignal Statement - # $tRee = read("tmp/sentSSF.$$"); - $tRee = __PACKAGE__->can('read')->(\@sent); - my $dub_tree = copy_tree($tRee); - $_Story_[$body_num]->[$pnum]->[$sentnum] = $dub_tree; - $sentf = 0; - $_Story_[$body_num]->[$pnum]->[0]->{'numSens'} = $sentnum; - } - $_Story_[0]->{"body_count"} = $body_num; - $_Story_[0]->{"first_line"} = $first_l; - $_Story_[0]->{"second_line"} = $second_l; - $_Story_[0]->{"third_line"} = $third_l; - $_Story_[0]->{"last_line"} = $last_line; - $_Story_[0]->{"meta"} = $meta; - - return \@_Story_; -} - -# Litha Changes -# To print the sentence with given tb_no: and sent_id -sub printsentence -{ - my $pnum = $_[0]; - my $sent_id = $_[1]; - my $StoryRef=\@_Story_; - my $p_counter = 0; - my $sent_counter =0; - my $reach = 0; - - for(my $i = 1;($i<=$StoryRef->[0]->{"body_count"}) && ($reach == 0);$i++) - { - my $paras = $StoryRef->[$i]; - my $paracount = get_paracount($paras); - - if($pnum <= $paracount) - { - for(my $j = 1;($j<=$paracount) && ($reach == 0);$j++) - { - $para = get_para($j); - my($numSent) = get_sentcount($para); - $paraf = 1; - if(($j == $pnum) || ($pnum == 0)) - { - for(my $k = 1;($k<=$numSent) && ($reach == 0);$k++) - { - $curr_sent=$para->[0]->{'sent_Ids'}->[$k]; - $sentf = 1; - if($sent_id == $curr_sent) - { - $reach =1; - $tb_no = $j; - $sent_counter = $k; - } - } - } - } - } - } - if(($reach == 1)) - { - if($pnum == 0) - { - print "\ntb_num is available.But user is not providing the tb_num: $tb_no\n"; - print "sentence_id: $sent_id is present in the tb_num: $tb_no \n"; - } - print "\nSentence: \n"; - print "\ntb_ num: $tb_no\tSentence_id: $sent_id"."\n\n"; - - my($sent) = get_sent($para,$sent_counter); - print_tree($sent); - print "\n"; - } - else{ - if(!$paraf) - { - print "\nError : tb_num is not available.But user is providing the tb_num:\n\n"; - } - elsif(($paraf) && ($pnum == 0)) - { - print "\nError : tb_num is available.But user is not providing the tb_num.\n"; - print "Sentence_id: $sent_id is not present in the all tb_nums: \n\n" - } - else - { - print "\nSentence_id: $sent_id is not present in the tb_num : $pnum\n\n"; - } - } -} - -sub get_paracount -{ - my $paras = $_[0]; - - return $#{$paras}; -} - -sub get_bodycount -{ - my $StoryRef = $_[0]; - - if(not(defined($StoryRef))) - {$StoryRef=\@_Story_;} - - return $StoryRef->[0]->{'body_count'}; - -} - -sub get_body -{ - my($bodyNum) = $_[0]; - my($StoryRef) = $_[1]; - - if(!defined($StoryRef)) { - $StoryRef=\@_Story_; - } - - return $StoryRef->[$bodyNum]; -} - - -sub get_para -{ - my $paranum = $_[0]; - my $StoryRef = $_[1]; - - if(not(defined($_[1]))) - {$StoryRef=\@_Story_;} - - return $StoryRef->[1]->[$paranum]; -} - -sub get_sentcount -{ - my $ParaRef = $_[0]; - - # Sriram Changes - return $ParaRef->[0]->{'numSens'}; -} - -sub get_sent -{ - my $ParaRef = $_[0]; - my $sentnum = $_[1]; - - return $ParaRef->[$sentnum]; -} - -sub print_para -{ - my $paranum = $_[0]; - my $StoryRef = $_[1]; - - if(not(defined($_[1]))) - {$StoryRef=\@_Story_;} - - my $sentences = $StoryRef->[1]->[$paranum]; - - # INformation is there in $StoryRef->[1]->[$paranum]->[0]-> - my $segment = $StoryRef->[1]->[$paranum]->[0]->{'segment'}; - my $bullet = $StoryRef->[1]->[$paranum]->[0]->{'bullet'}; - -# print "

\n"; - print "\n"; - #print "\n"; - print "\n"; - #print "{'numSens'}; $k++) - { - $sentcount++; - print "\n"; - print_tree($sentences->[$k]); - print "\n"; - } - #print "

\n\n"; - print "\n"; - print "\n"; - print "\n"; - -} - -sub print_pararef -{ - my $sentences = $_[0]; - - #print "\n"; - #print "\n"; - #print "

\n"; - #print "\n"; - - for(my $k = 1; $k <= $sentences->[0]->{'numSens'}; $k++) - { - $sentcount++; - print "\n"; - print_tree($sentences->[$k]); - print "\n"; - } - - print "\n"; - #print "\n"; - #print "\n"; - #print "\n\n"; -} - - -sub printstory -{ - my $StoryRef = $_[0]; - - if(not(defined($_[0]))) - {$StoryRef=\@_Story_;} - - # Litha Changes up to end of this function - print "$StoryRef->[0]->{\"first_line\"}$StoryRef->[0]->{\"second_line\"}$StoryRef->[0]->{\"third_line\"}$StoryRef->[0]->{\"meta\"}"; - my $sentcount = 0; - - for(my $i = 1; $i <= $StoryRef->[0]->{"body_count"}; $i++) - { - my $paras = $StoryRef->[$i]; - if($paras->[0]->{'body_visible'} == 1) - { - print "\n\n"; - } - my $paracount = get_paracount($paras); - - for(my $j = 1; $j <= $paracount; $j++) - { - my $para = $paras->[$j]; - - # INformation is there in $StoryRef->[1]->[$paranum]->[0]-> - my $segment = $para->[0]->{'segment'}; - my $bullet = $para->[0]->{'bullet'}; - - if($para->[0]->{'para_visible'} == 1) - { - print "[0]->{'number'}\" segment=\"$segment\" bullet=\"$bullet\">\n"; - } - if($para->[0]->{'text_visible'} == 1) - { - print "\n"; - } - - for(my $k = 1; $k <= $para->[0]->{'numSens'}; $k++) - { - $sentcount++; - if($para->[0]->{'sent_visible'} == 1) - { - # Sriram change - print "[0]->{'sent_Ids'}->[$k]."\">\n"; - } - print_tree($para->[$k]); - if($para->[0]->{'sent_visible'} == 1) - { - print "\n"; - } - } - if($para->[0]->{'text_visible'} == 1) - { - print "\n"; - print "\n"; - } - if($para->[0]->{'para_visible'} == 1) - { - print "\n"; - } - } - if($paras->[0]->{'body_visible'} == 1) - { - print "\n"; - } - } - - print "$StoryRef->[0]->{\"last_line\"}"; -} - -sub printstory_file -{ - my $outfile = $_[0]; - my $StoryRef = $_[1]; - - if(not(defined($_[1]))) - {$StoryRef=\@_Story_;} - - open(OUT, ">$outfile") or die("could not open the file $outfile to write\n"); - # Litha Changes upto end of the program - print OUT "$StoryRef->[0]->{\"first_line\"}$StoryRef->[0]->{\"second_line\"}$StoryRef->[0]->{\"third_line\"}$StoryRef->[0]->{\"meta\"}"; - my $sentcount = 0; - - for(my $i = 1; $i <= $StoryRef->[0]->{"body_count"}; $i++) - { - my $paras = $StoryRef->[$i]; - if($paras->[0]->{'body_visible'} == 1) - { - print OUT "\n\n"; - } - my $paracount = get_paracount($paras); - for(my $j = 1; $j <= $paracount; $j++) - { - my $para = $paras->[$j]; - my $segment = $para->[0]->{'segment'}; - my $bullet = $para->[0]->{'bullet'}; - my $lang = $para->[0]->{'language'}; - if($para->[0]->{'para_visible'} == 1) - { - print OUT "\n"; - } - if($para->[0]->{'text_visible'} == 1) - { - print OUT "\n"; - } - for(my $k = 1; $k <= $para->[0]->{'numSens'}; $k++) - { - $sentcount++; - if($para->[0]->{'sent_visible'} == 1) - { - print OUT "[0]->{'sent_Ids'}->[$k]."\">\n"; - close(OUT); - } - print_tree_file(">>$outfile", $para->[$k]); - open(OUT, ">>$outfile") or die("could not open the file $outfile to write\n"); - if($para->[0]->{'sent_visible'} == 1) - { - print OUT "\n"; - } - } - if($para->[0]->{'text_visible'} == 1) - { - print OUT "\n"; - print OUT "\n"; - } - if($para->[0]->{'para_visible'} == 1) - { - print OUT "\n"; - } - } - if($paras->[0]->{'body_visible'} == 1) - { - print OUT "\n"; - } - } - print OUT "$StoryRef->[0]->{\"last_line\"}"; - close(OUT); -} - - -sub copy_story # This will copy the entire story and return a reference to that story. -{ - my @copyStory; - my $StoryRef=$_[0]; - - if(not(defined($_[0]))) - { - $StoryRef=\@_Story_; - } - - $copyStory[0]->{"body_count"} = $StoryRef->[0]->{"body_count"}; - $copyStory[0]->{"first_line"} = $StoryRef->[0]->{"first_line"}; - $copyStory[0]->{"second_line"} = $StoryRef->[0]->{"second_line"}; - $copyStory[0]->{"third_line"} = $StoryRef->[0]->{"third_line"}; - $copyStory[0]->{"meta"} = $StoryRef->[0]->{"meta"}; - - - - my $sentcount = 0; - - for(my $i = 1; $i <= $StoryRef->[0]->{"body_count"}; $i++) - { - $copyStory[$i] = $StoryRef->[$i]; - my $para = $StoryRef->[$i]; - $copyStory[$i]->[0] = $para->[0]; - - for(my $j = 1; $j <= $para->[0]; $j++) - { - $copyStory[$i]->[$j] = $para->[$j]; - $copyStory[$i]->[$j]->[0] = $para->[$j]->[0]; - } - } - - - return \@copyStory; # Return a reference to the copied version of the story. -} - -#% Reads the file into the data-structure @_TREE_ -#% read ([$filename]) -#% -sub read -{ - my @Load; - # Litha Changes - # Orignal Statement - # my $filename; - # $filename=$_[0]; - # if($filename) - # { - # open(stdin,$filename) or die $!."\n"; - # } - my $sent_ref; - $sent_ref=shift; - - - undef(@_TREE_); - - $_TREE_[0][1]="0"; - $_TREE_[0][2]="(("; - $_TREE_[0][3]="SSF"; - $_TREE_[0][4]=""; - - my $nElements=1; - # Litha Changes - # Orignal Statement - #while() - foreach (@$sent_ref) - { - chomp; - if(/(^\#)|(^\<\S+\>)/ or /^\s*$/ or /^\s*\<\/S\>/) - { next; } - - ($_TREE_[$nElements][1],$_TREE_[$nElements][2],$_TREE_[$nElements][3],$_TREE_[$nElements][4])=split(/\t/,$_); - $_TREE_[$nElements][4]=~s/\/>/>/g; - $_TREE_[$nElements][4]=~s/\/\/>/\//g; - $nElements++; - } - - $_TREE_[$nElements][2]="))"; - assign_reach(\@_TREE_); -} - -# Assign the zeroth and the first field -# assign_reach( [$tree] ) -# -sub assign_reach -{ - my $TreeRef=$_[0]; # Reference to the tree structure. - my @markerArray; - my $i=0; - - if(not(defined($_[0]))) - { $TreeRef=\@_TREE_; } - - for(my $i=0;$i<@$TreeRef;$i++) - { - if($$TreeRef[$i][2]=~/\)\)/) - { - for(my $j=$i;$j>=0;$j--) - { - if($markerArray[$j][0] eq "Open") # Closing the last opened node. - { - $markerArray[$j][0]="Closed"; - $$TreeRef[$j][0]=($markerArray[$j][1]+1); - - last; - } - } - } - elsif($$TreeRef[$i][2]=~/\(\(/) # Marking the open of a starting node. - { - $markerArray[$i][0]="Open"; - $markerArray[$i][1]=0; - } - else # Marking the general nodes. - { - $$TreeRef[$i][0]=1; - } - - for(my $j=$i;$j>=0;$j--) # Incrementing the reach of each open node. - { - if($markerArray[$j][0] eq "Open") - { - $markerArray[$j][1]++; - } - } - } - - return; -} - -#% Prints the data-structure -#% print_tree( [$tree] ) -nil- -#% - -sub print_tree -{ - my $TreeRef=$_[0]; - my ($zeroth,$first,$second,$third,$fourth); - - if(not(defined($_[0]))) - { $TreeRef=\@_TREE_; } - assign_reach($TreeRef); - assign_readable_numbers($TreeRef); - for(my $i=1;$i>abc.tmp" for appending to a file -#% Added by Aseem - 12/9/04 - -sub print_tree_file - -{ - - my $FileRef=$_[0]; - my $TreeRef=$_[1]; - my ($zeroth,$first,$second,$third,$fourth); - - if(not(defined($_[0]))) - { die("File not given!\n"); } - if(not(defined($_[1]))) - { $TreeRef=\@_TREE_; } - - if ($_[0] =~ /\>\>/) { - open(FILE,"$FileRef"); - } - else { - open(FILE,">$FileRef"); - } - assign_reach($TreeRef); - assign_readable_numbers($TreeRef); - for(my $i=1;$i<@$TreeRef-1;$i++) - { - $first=$$TreeRef[$i][1]; - $second=$$TreeRef[$i][2]; - $third=$$TreeRef[$i][3]; - $fourth=$$TreeRef[$i][4]; - print FILE "$first\t$second\t$third\t$fourth\n"; - } - close(FILE); - return; -} - -#% Changes the numbers in the first field -#% assign_readable_numbers([$tree]) -> -nil- -#% Nothing is returned -#% - -sub assign_readable_numbers -{ - my $TreeRef=$_[0]; - if(not(defined($_[0]))) - { $TreeRef=\@_TREE_; } - - - my @childNodes=get_children(0,$TreeRef); - - for(my $i=1;$i<=@childNodes;$i++) - { - modify_field($childNodes[$i-1],1,$i,$TreeRef); - reorder_numbers($childNodes[$i-1],$i,$TreeRef); - } - - return; -} - -#% Changes the numbers in the first field -#% assign_readable_numbers($node,$parentNumber,[$tree]) -> -nil- -#% Nothing is returned -#% - -sub reorder_numbers -{ - my $index=$_[0]; - my $parent=$_[1]; - my $TreeRef=$_[2]; - - if(not(defined($_[2]))) - { $TreeRef=\@_TREE_; } - - my @childNodes=get_children($index,$TreeRef); - - if(@childNodes==0) - { return; } - - for(my $i=1;$i<=@childNodes;$i++) - { - modify_field($childNodes[$i-1],1,$parent.".".$i,$TreeRef); - reorder_numbers($childNodes[$i-1],$parent.".".$i,$TreeRef); - } - - return; -} - - -#% print_node($index,[$tree]) -#% - -sub print_node -{ - my ($zeroth,$first,$second,$third,$fourth); - my $index=$_[0]; - my $TreeRef=$_[1]; - - if(not(defined($_[0]))) - { $TreeRef=\@_TREE_; } - - my $nextPosition=get_next_node($index,$TreeRef); - - for(my $i=$index;$i<$nextPosition;$i++) - { - $first=$$TreeRef[$i][1]; - $second=$$TreeRef[$i][2]; - $third=$$TreeRef[$i][3]; - $fourth=$$TreeRef[$i][4]; - - print "$first\t$second\t$third\t$fourth\n"; - } -} - -#% Gets the children nodes -#% get_children( $node , [$tree] ) -> @children_nodes; -#% To get children of root, $node = 0; -#% -sub get_children -{ - my $node=$_[0]; # Passing the node number is compulsory. - my $TreeRef=$_[1]; # This is a reference to the tree array. - my @childIndexArray; - - if(not(defined($_[1]))) - { $TreeRef=\@_TREE_; } - - for(my $i=$node+1;$i<$node+$$TreeRef[$node][0];) - { - if(not($$TreeRef[$i][2]=~/\)\)/)) # Get only the children at the next layer - { - push(@childIndexArray,$i); - $i+=$$TreeRef[$i][0]; # This will get all the children in that tree passed to the function. - } # We do not get the grand children - else - { - $i+=1; - } - } - - return @childIndexArray; # Return a reference to the child array. -} - -#% Gets the Leaf nodes -#% get_leaves( [$tree] ) -> @leaf_nodes; -#% -sub get_leaves -{ - my $TreeRef=$_[0]; - my @leafArray; - - if(not(defined($_[0]))) - { $TreeRef=\@_TREE_; } - - for(my $i=0;$i<@$TreeRef;$i++) - { - if(not($$TreeRef[$i][2]=~/\)\)/)) # We do not pass those nodes that have )) - { - if($$TreeRef[$i][0]==1) # If it is a leaf node then.. - { push(@leafArray,$i); } - } - } - - return @leafArray; # Return the reference to the leaf array. -} - -sub get_leaves_child -{ - my $TreeRef=$_[1]; - my $index=$_[0]; - my @leafArray; - - if(not(defined($_[1]))) - { $TreeRef=\@_TREE_; } - - for(my $i=$index+1;$i<$index+$$TreeRef[$index][0];$i++) - { - if(not($$TreeRef[$i][2]=~/\)\)/)) - { - if($$TreeRef[$i][0]==1) - { - push(@leafArray,$i); - } - } - } - return @leafArray; -} - -#% Get the nodes which have a particular field-value. -#% get_nodes( $fieldnumber , $value , [$tree] ) -> @required_nodes -#% -sub get_nodes -{ - my $index=$_[0]; - my $value=$_[1]; - my $TreeRef=$_[2]; - my @nodeArray; - - if(not(defined($_[2]))) - { $TreeRef=\@_TREE_; } - - for(my $i=0;$i<@$TreeRef;$i++) - { - if($$TreeRef[$i][$index] eq $value) - { push(@nodeArray,$i); } - } - - return @nodeArray; # Return a reference to the node array. -} - -#% Get the nodes which have a particular field-value. -#% get_nodes_pattern( $fieldnumber , $value , [$tree] ) -> @required_nodes -#% - -sub get_nodes_pattern -{ - my $index=$_[0]; - my $value=$_[1]; - my $TreeRef=$_[2]; - my @nodeArray; - - if(not(defined($_[2]))) - { $TreeRef=\@_TREE_; } - - for(my $i=0;$i<@$TreeRef;$i++) - { - if($$TreeRef[$i][$index]=~/$value/) - { push(@nodeArray,$i); } - } - - return @nodeArray; # Return a reference to the node array. -} - -#% Deletes a node -#% delete_node( $node , [$tree] ) -#% -sub delete_node -{ - # We delete a node from the referred tree itself - # We do not give a copy of the tree. - - my $node=$_[0]; # First Arg is the index in the array from where the node has to be deleted. - my $TreeRef=$_[1]; # Reference to the tree to which the function has to be applied. - my $j=0; - - if(not(defined($_[1]))) # If reference is not specified then take the default reference. - { $TreeRef=\@_TREE_; } - - my $numEle=@$TreeRef; - - for(my $i=0;$i<$numEle;) - { - if($i==$node) - { - if(not($$TreeRef[$i][0]=~/\)\)/)) - { - $i+=$$TreeRef[$i][0]; # This means that we have abandoned that node. - } - else - { - $i+=1; - } - } - - if($j!=$i) - { - undef($$TreeRef[$j]); - $$TreeRef[$j]=$$TreeRef[$i]; # copy the values in one part to the other. - } - - $i++;$j++; - } - - for(;$j<$numEle;$j++) - { pop(@$TreeRef); } - - - assign_reach($TreeRef); - return; # We return nothing. -} - -#% Create a parent for a sequence of nodes -#% create_parent( $node_start , $node_end , $tag , [$tree] ); -#% -sub create_parent -{ - my $startIndex=$_[0]; - my $endIndex=$_[1]; # Specify the ending index - my $tag=$_[2]; - my $TreeRef=$_[3]; - my $specifier=0; - - if(not(defined($_[3]))) - { - $TreeRef=\@_TREE_; - } - my @temp; - my @temp2; - my $nElements=@$TreeRef; - - for(my $i=$nElements-1;$i>=$startIndex;$i--) - { - for(my $j=0;$j<5;$j++) - { $$TreeRef[$i+1][$j]=$$TreeRef[$i][$j]; } - } - - undef($$TreeRef[$startIndex]); - $$TreeRef[$startIndex][0]=""; - $$TreeRef[$startIndex][1]=""; - $$TreeRef[$startIndex][2]="(("; - $$TreeRef[$startIndex][3]=$tag; - - $endIndex+=$$TreeRef[$endIndex+1][0]+1; - $nElements=@$TreeRef; - - for(my $i=$nElements-1;$i>=$endIndex;$i--) - { - for(my $j=0;$j<5;$j++) - { $$TreeRef[$i+1][$j]=$$TreeRef[$i][$j]; } - } - undef($$TreeRef[$endIndex]); - $$TreeRef[$endIndex][0]=""; - $$TreeRef[$endIndex][1]=""; - $$TreeRef[$endIndex][2]="))"; - - assign_reach($TreeRef); # Modify the Reach values in the tree. - return $startIndex; -} - -#% Delete the parent but keep the children -#% delete_layer ( $node , [$tree] ) -#% -sub delete_layer -{ - my $index=$_[0]; - my $TreeRef=$_[1]; - my $final; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - $final=$$TreeRef[$index][0]+$index; - my $numEle=@$TreeRef; - - for(my $i=$index;$i<$numEle-1;$i++) # First you remove the node that was passed to you. - { - $$TreeRef[$i]=$$TreeRef[$i+1]; - } - - pop(@$TreeRef); # Decrease the tree size, saying that we have deleted a node. -# Now if index!=final-1 then we need to delete the node at final-1 also. - - $numEle=@$TreeRef; - - if($index!=$final-1) # If that node we deleted happened to be a parent node then... - { - for(my $i=$final-2;$i<$numEle;$i++) # Delete it's corresponding closing brace )) - { # Which will be at $final-2 because we have already deleted one - $$TreeRef[$i]=$$TreeRef[$i+1]; # node from the tree. - } - - pop(@$TreeRef); - } - -# $nElements=@$TreeRef; - assign_reach($TreeRef); # Modify the reach values. - - return; -} - -#% Creates a new tree -#% create_tree; -> $empty_tree; -#% -sub create_tree -{ - # The 3 fields of a node are sent by the user. - - my @Tree; - $$Tree[0][0]="3"; - $Tree[0][1]="0"; - $Tree[0][2]="(("; - $Tree[0][3]="SSF"; - #$Tree[1][0]=1; # This is the reach value - #$Tree[1][1]="1 "; # This will be assigned by a seperate function. - ##$Tree[1][2]=$_[0]; - #$Tree[1][3]=$_[1]; - #$Tree[1][4]=$_[2]; - $Tree[1][0]=""; - $Tree[1][1]=""; - $Tree[1][2]="))"; - - return \@Tree; # Return a reference to the tree. -} - -#% -#% add_tree -#% -sub add_tree # Found a bug on 29th Oct 2003 and fixed on the same day. -{ - my $addNodeRef=$_[0]; # This is the reference array from which the values are added into the present tree - my $position=$_[1]; - my $direction=$_[2]; - my $TreeRef=$_[3]; - - if(not(defined($_[3]))) - { - $TreeRef=\@_TREE_; - } - - if($direction eq "1") - { - $position+=$$TreeRef[$position][0]; - } - - my $numEle=@$TreeRef; # Number of elements in the array before it was modified. - my $offset=$$addNodeRef[0][0]; - - - for(my $i=$numEle-1;$i>=$position;$i--) # Start from the position where you have to add the new node. - { - for(my $j=0;$j<5;$j++) - { - $$TreeRef[$i+$offset-2][$j]=$$TreeRef[$i][$j]; # Make space for the coming new node, -2 is for the elimination - } - # of the first and last parantheses. - } - - for(my $i=$position;$i<$position+$offset-2;$i++) # Copy the new node in the space created previously. - { - undef($$TreeRef[$i]); - $$TreeRef[$i]=$$addNodeRef[$i-$position+1]; # The reason we add 1 to the index id because - } # The tree has A starting (( SSF and closing )) which - # are to be left out. - assign_reach($TreeRef); # Modify the Reach values in the tree. -} - -#% -#% add_node ( $tree , $sibling_node , $direction (0/1) ,[$tree]) -> $index_node -#% -sub add_node -{ - my $addNodeRef=$_[0]; # This is the reference array from which the values are added into the present tree - my $position=$_[1]; - my $direction=$_[2]; - my $TreeRef=$_[3]; - - - if(not(defined($_[3]))) - { - $TreeRef=\@_TREE_; - } - - - if($direction eq "1") - { - $position+=$$TreeRef[$position][0]; - } - - my $numEle=@$TreeRef; # Number of elements in the array before it was modified. - my $offset=$$addNodeRef[0][0]; - - for(my $i=$numEle-1;$i>=$position;$i--) # Start from the position where you have to add the new node. - { - for(my $j=0;$j<5;$j++) - { - $$TreeRef[$i+$offset][$j]=$$TreeRef[$i][$j]; # Make space for the coming new node. - } - undef($$TreeRef[$i]); - } - - for(my $i=$position;$i<$position+$offset;$i++) # Copy the new node in the space created previously. - { - for(my $j=0;$j<5;$j++) - { - $$TreeRef[$i][$j]=$$addNodeRef[$i-$position][$j]; - } - } - - assign_reach($TreeRef); # Modify the Reach values in the tree. -} - -#% Get's all the fields of a given leaf/node -#% get_fields ( $node , [$tree] ) -> ($zeroth,$first,$second,$third,$fourth) -#% -sub get_fields -{ - my $node=$_[0]; - my $TreeRef=$_[1]; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - return ($$TreeRef[$node][0],$$TreeRef[$node][1],$$TreeRef[$node][2],$$TreeRef[$node][3],$$TreeRef[$node][4]); - #return $$TreeRef[$node]; # Return that array to the user. -} - -#% Get a particular field of a leaf/node -#% get_field ( $node , $fieldnumber , [$tree] ) -> $value_of_field -#% -sub get_field -{ - my $node=$_[0]; - my $index=$_[1]; - my $TreeRef=$_[2]; - - if(not(defined($_[2]))) - { - $TreeRef=\@_TREE_; - } - - return $$TreeRef[$node][$index]; # Return the required index -} - -#% Modify a particular field of a leaf/node -#% modify_field( $node , $fieldnumber , $value , [$tree] ) -#% -sub modify_field -{ - my $node = $_[0]; - my $index = $_[1]; - my $value = $_[2]; - my $TreeRef=$_[3]; - - if(not(defined($_[3]))) - { - $TreeRef=\@_TREE_; - } - - $$TreeRef[$node][$index] = $value; -} - -#% Copy a node as another tree -#% copy ( $node ) -> $tree -#% If entire tree has to be copied, $node = 0 -#% -sub copy # This creates a copy of the node specified and returns the corresponding -{ # Two dimensional array. - my $nodeIndex=$_[0]; - my $TreeRef=$_[1]; - my @nodeCopy; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - if(not($$TreeRef[$nodeIndex][2]=~/\)\)/)) - { - for(my $i=$nodeIndex;$i<$nodeIndex+$$TreeRef[$nodeIndex][0];$i++)# Make a copy of that node and return it. - { - for(my $j=0;$j<5;$j++) # copy field by field and return a reference to that array. - { - $nodeCopy[$i-$nodeIndex][$j]=$$TreeRef[$i][$j]; - } - } - } - else - { - return -1; # That is not a node. - } - - return \@nodeCopy; # Returning a reference to the node array created. -} - -#% Move a node to a particular place -#% move_node( $node , $node2 , $direction , [$tree] ) -#% $direction = 0 if before the sibiling, 1 if after ths sibling -#% -sub move_node -{ - my $nodeIndex=$_[0]; - my $node2=$_[1]; - my $direction=$_[2]; # The direction is either "up" or "down" - my $TreeRef=$_[3]; - my $nodeCopy=copy($nodeIndex); - $tempCopy=$nodeCopy; - - if(not(defined($_[3]))) - { - $TreeRef=\@_TREE_; - } - - if($direction eq "0") # Since we are deleting an element below position to where it has to be moved - { # It will be moved to the position above the specified number of positions. - if($node2 > $nodeIndex) - { - $node2=$node2-$$TreeRef[$nodeIndex][0]; - } - delete_node($nodeIndex,$TreeRef); # the new position is $nodeIndex-$numberOfPositions. - add_node($nodeCopy,$node2,"0",$TreeRef); -# e.g. if numberOfPositions is 3 then node will be inserted above the third position. from the present node. - } - elsif($direction eq "1") - { # It will be moved to the position below the specified number of positions. - my $reachValue=$$TreeRef[$nodeIndex][0]; - add_node($nodeCopy,$node2,"1",$TreeRef); - - if($node2<$nodeIndex) - { - delete_node($nodeIndex+$reachValue,$TreeRef); - } - else - { - delete_node($nodeIndex,$TreeRef); - } -# e.g. if numberOfPositions is 3 then node will be inserted below the third position. from the present node. - } - else - { - print "ERROR IN SPECIFYING THE DIRECTION\n"; - } - # There is no need of calling the modifyReachValues function here because the functions that we have called earlier - # Will take care of that. -} - -#% Copy the entire tree -#% copy_tree ( [$tree] ) -> $tree2 -#% -sub copy_tree # This will copy the entire tree and return a reference to that tree. -{ - my @copyTree; - my $TreeRef=$_[0]; - - if(not(defined($_[0]))) - { - $TreeRef=\@_TREE_; - } - - for(my $i=0;$i<@$TreeRef;$i++) - { - for(my $j=0;$j<5;$j++) # copy all the elements of the tree and return a reference to the copy. - { - $copyTree[$i][$j]=$$TreeRef[$i][$j]; - } - } - - return \@copyTree; # Return a reference to the copied version of the tree. -} - -#% Gets the parent of a node -#% get_parent( $node , [$tree] ) -> $parent_node -#% -sub get_parent # Gets the index of the parent to the node specified. -{ - my $nodeIndex=$_[0]; - my $TreeRef=$_[1]; - my $matchBraces=0; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - my $parent=-1; - - for(my $i=$nodeIndex-1;$i>=0;$i--) - { - if($$TreeRef[$i][2]=~/\(\(/)# Search until you reach the node with the opening paranthesis; - { - if($matchBraces eq 0) # If that is an opening paranthesis and not a sibling - { - $parent=$i; - last; - } - else - { - $matchBraces--; - } - } - - if($$TreeRef[$i][2]=~/\)\)/) - { - $matchBraces++; - } - } - - return $parent; # A node will have atleast one parent. which is the SSF node introduced in the beginning. -} - -#% Gets the next sibling -#% get_next_node( $node , [$tree] ) -> $next_node -#% -sub get_next_node # Gets the index of the sibling (of the node specified) present below the present one. -{ - my $nodeIndex=$_[0]; - my $TreeRef=$_[1]; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - if($$TreeRef[$nodeIndex][2]=~/\)\)/) - { return -1; } - - if(not($$TreeRef[$nodeIndex+$$TreeRef[$nodeIndex][0]][2]=~/\)\)/)) # Return the index of the next node. - { return ($nodeIndex+$$TreeRef[$nodeIndex][0]); } - else - { return -1; } # This indicates that it has no sibling. - -} - - -#% Gets the previous sibling -#% get_previous_node( $node , [$tree] ) -> $previous_node -#% -sub get_previous_node -{ - my $nodeIndex=$_[0]; - my $TreeRef=$_[1]; - - if(not(defined($_[1]))) - { - $TreeRef=\@_TREE_; - } - - if($$TreeRef[$nodeIndex-1][2]=~/\(\(/) # This means that it has a parent immediately before it - { return -1; } # And hence does not have a sibling before it .So we return -1. - - if(not($$TreeRef[$nodeIndex-1][2]=~/\)\)/)) # If its previous node is not a closing bracket then just return that - { - return $nodeIndex-1; # A minus one is returned in case of $nodeIndex of 0. - } - - my $parent=get_parent($nodeIndex); # If its previous node happens to be a more complicated node then. - - if($parent eq -1) - { return -1; } - -# print "$parent\n\n"; - - for(my $i=$nodeIndex-1;$i>$parent;$i--) - { - if($$TreeRef[$i][2]=~/\(\(/) - { - return $i; # Incase you encounter a closing Bracket then just return the first bracket you see. - } - } - - return -1; -} - -#% Adds a leaf before/after a node -#% add_leaf( $node , $direction[0/1] , $f2 , $f3, $f4) -#% -sub add_leaf -{ - my $position=$_[0]; - my $direction=$_[1]; - my $f2=$_[2]; - my $f3=$_[3]; - my $f4=$_[4]; - my $TreeRef; - $TreeRef=$_[5]; - - - - if(not(defined($_[5]))) - { - $TreeRef=\@_TREE_; - } - - if($direction eq "1") - { - $position+=$$TreeRef[$position][0]; - } - - my $numEle; - $numEle=@$TreeRef; # Number of elements in the array before it was modified. - - # Since this is the leaf node it is assumed that the offset required is 1. - - for(my $i=$numEle-1;$i>=$position;$i--) # Start from the position where you have to add the new node. - { - for(my $j=0;$j<5;$j++) - { - $$TreeRef[$i+1][$j]=$$TreeRef[$i][$j]; # Make space for the coming new node. - } - undef($$TreeRef[$i]); - } - - $$TreeRef[$position][2]=$f2; - $$TreeRef[$position][3]=$f3; - $$TreeRef[$position][4]=$f4; - - assign_reach($TreeRef); -} - -sub change_old_new -{ - my $TreeRef=$_[0]; - if(not(defined($_[0]))) - { - $TreeRef=\@_TREE_; - } - - for(my $i=0;$i<@$TreeRef;$i++) - { - my $featureStructure=$$TreeRef[$i][4]; - my $reference=read_FS_old($featureStructure); - my $convertedFeature=make_string($reference); - $$TreeRef[$i][4]=$convertedFeature; - } - - return; -} - -sub change_new_old -{ - my $TreeRef=$_[0]; - if(not(defined($_[0]))) - { - $TreeRef=\@_TREE_; - } - - for(my $i=0;$i<@$TreeRef;$i++) - { - my $featureStructure=$$TreeRef[$i][4]; - my $reference=read_FS($featureStructure); - my $convertedFeature=make_string_old($reference); - $$TreeRef[$i][4]=$convertedFeature; - } - - return; -} - -sub delete_tree { - undef(@_TREE_); -} - - -# REPORT BUGS TO ANY ONE OF THE ID's GIVEN BELOW -# p_nirupam@students.iiit.net -# (or) sriram@students.iiit.net - -1; diff --git a/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti.pm b/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti.pm deleted file mode 100755 index 27eb9b9b1eb1dd8cf70c1cfc714d5ce81df8a6ce..0000000000000000000000000000000000000000 --- a/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti.pm +++ /dev/null @@ -1,213 +0,0 @@ -package ILMT::KAN::HIN::ComputeVibhakti; -#use strict; -#use warnings; -use Dir::Self; -use Data::Dumper; -use ILMT::KAN::HIN::SSFAPI::feature_filter; -use ILMT::KAN::HIN::SSFAPI::shakti_tree_api; -use ILMT::KAN::HIN::ComputeVibhakti::ComputeTAM; - -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; -} - -#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 $vibh_home = @_[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; - } - } - #Deletes the leaves containing vibhakti. - $delete=0; - foreach (@remove) - { - &delete_node($_-$delete,$sent); - $delete++; - } - delete @remove[0..$#remove]; -} - -1; diff --git a/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti/ComputeTAM.pm b/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti/ComputeTAM.pm deleted file mode 100755 index 010575ababeb9a4f04e965f04916adc5bedd5c43..0000000000000000000000000000000000000000 --- a/modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti/ComputeTAM.pm +++ /dev/null @@ -1,289 +0,0 @@ -package ILMT::KAN::HIN::ComputeVibhakti::ComputeTAM; -use ILMT::KAN::HIN::SSFAPI::feature_filter; -use ILMT::KAN::HIN::SSFAPI::shakti_tree_api; -use Exporter qw(import); - -our @EXPORT = qw(ComputeTAM); - -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]; - } - 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(); -} -1; - diff --git a/server.json b/server.json index 5361fd58577ceddec1bdb974de0041a37d2c4908..f2e81fa5faed8f232fc807423ff685b05a6612af 100644 --- a/server.json +++ b/server.json @@ -1,3 +1,3 @@ { - "kan" : "http://10.2.63.52:8585/partialtranslate/new/kan/hin/1/12/partial" + "kan" : "http://10.2.63.52:8585/partialtranslate/new/kan/hin/1/11/partial" }