Skip to content

GitLab

I
ilmt-api-kan-shallowparser
Commit e0d08a7a authored by priyank's avatar priyank
Browse files
Options

removed vibhakticompute

parent 5568b960
Hide whitespace changes
Inline Side-by-side
Showing with 1 addition and 3308 deletions
lib/ILMT/KAN/HIN.pm
View file @ e0d08a7a
......@@ -15,7 +15,6 @@ my @seq = (
"PickOneMorph",
"Repair",
"ComputeHead",
"ComputeVibhakti",
"WX2UTF"
);
......
modules/ILMT-KAN-HIN-ComputeVibhakti/.gitmodules deleted 100755 → 0
View file @ 5568b960
[submodule "API"]
path = API
url = https://gitlab.com/ilmt/ILMT-TEL-HIN-SSFAPI.git
modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/feature_filter.pm deleted 100755 → 0
View file @ 5568b960
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 <Not the reference>
}
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. <This is the copied 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. <This is the copied 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.="<af="; # When we see lex we add this and then continue.
$String.="<fs af='"; # When we see lex we add this and then continue.
for(my $i=0;$i<8;$i++)
{
my $arrayRef;
$arrayRef=$$hashRef{$array[$i]};
for(my $j=0;$j<@$arrayRef;$j++)
{
if(ref($$arrayRef[$j]) eq "HASH")
{
$String.=make_string_2($$arrayRef[$j]);
}
else
{
$String.=$$arrayRef[$j];
}
if($i+1<@$arrayRef)
{
$String.="|";
}
}
if($i!=7)
{ $String.=","; }
else
{
if(@keyValues>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/\//\|/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/\//\|/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;
modules/ILMT-KAN-HIN-ComputeVibhakti/API/lib/ILMT/KAN/HIN/SSFAPI/shakti_tree_api.pm deleted 100755 → 0
View file @ 5568b960
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 = <IN>;
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] =~ /<document\sdocid/)
{
$third_l = $all_lines[$i]."\n\n";
$count++;
}
elsif($all_lines[$i] =~ /<\/document/)
{
$last_line = $all_lines[$i]."\n";
}
elsif($all_lines[$i] eq "<head>")
{
$metaf = 1;
$meta = "";
$meta = $meta."$all_lines[$i]\n";
$count++;
}
elsif($all_lines[$i] eq "</head>")
{
$meta = $meta."$all_lines[$i]\n\n";
$metaf = 0;
}
elsif($metaf == 1)
{
$meta = $meta."$all_lines[$i]\n";
}
elsif($all_lines[$i] eq "<body>")
{
$bodyf = 1;
$body_num++;
$_Story_[$body_num]->[0]->{'body_visible'}=1;
$count++;
}
elsif($all_lines[$i] eq "</body>")
{
$_Story_[$body_num]->[0]->{'num_para'} = $pnum;
$bodyf = 0;
$pnum = 0;
}
elsif($all_lines[$i]=~m/\<tb[ ]+number=\"([0-9][0-9]*)\"[ ]+segment=\"([a-zA-Z]+)\"[ ]+bullet=\"([a-zA-Z]+)\">/)
{
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 "</tb>")
{
# 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 language=\"([a-zA-Z]+)\"[ ]+writingsystem=\"(LTR)|(RTL)\"\>[ ]+\<\/foreign\>/){
# Sriram Changes
$_Story_[$body_num][$pnum]->[0]->{'language'} = $1;
$_Story_[$body_num][$pnum]->[0]->{'writingsystem'} = $2;
$count++;
$pnum++
}
elsif($all_lines[$i] =~ /<text>/)
{
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] =~ /<Sentence id="(\d+)"/)
{
if($textf == 0)
{
$bodyf=1;
$body_num++;
$_Story_[$body_num]->[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 "<p>\n";
print "<tb number=\"$paranum\" segment=\"$segment\" bullet=\"bullet\">\n";
#print "<tb number=\"$sentcount\" segment=\"yes\" bullet=\"yes\">\n";
print "<text>\n";
#print "<tb\n";
for(my $k = 1; $k <= @$sentences[0]->{'numSens'}; $k++)
{
$sentcount++;
print "<Sentence id=\"$sentcount\">\n";
print_tree($sentences->[$k]);
print "</Sentence>\n";
}
#print "</p>\n\n";
print "</text>\n";
print "<foreign language=\"\" writingsystem=\"\"></foreign>\n";
print "</tb>\n";
}
sub print_pararef
{
my $sentences = $_[0];
#print "<tb number=\"$sentcount\" segment=\"yes\" bullet=\"yes\">\n";
#print "<text>\n";
#print "<p>\n";
#print "<tb>\n";
for(my $k = 1; $k <= $sentences->[0]->{'numSens'}; $k++)
{
$sentcount++;
print "<Sentence id=\"$sentcount\">\n";
print_tree($sentences->[$k]);
print "</Sentence>\n";
}
print "</text>\n";
#print "<foreign language=\"\" writingsystem=\"\"></foreign>\n";
#print "</tb>\n";
#print "</tb>\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 "<body>\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 "<tb number=\"$para->[0]->{'number'}\" segment=\"$segment\" bullet=\"$bullet\">\n";
}
if($para->[0]->{'text_visible'} == 1)
{
print "<text>\n";
}
for(my $k = 1; $k <= $para->[0]->{'numSens'}; $k++)
{
$sentcount++;
if($para->[0]->{'sent_visible'} == 1)
{
# Sriram change
print "<Sentence id=\"".$para->[0]->{'sent_Ids'}->[$k]."\">\n";
}
print_tree($para->[$k]);
if($para->[0]->{'sent_visible'} == 1)
{
print "</Sentence>\n";
}
}
if($para->[0]->{'text_visible'} == 1)
{
print "</text>\n";
print "<foreign language=\"select\" writingsystem=\"LTR\"></foreign>\n";
}
if($para->[0]->{'para_visible'} == 1)
{
print "</tb>\n";
}
}
if($paras->[0]->{'body_visible'} == 1)
{
print "</body>\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 "<body>\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 "<tb number=\"$j\" segment=\"$segment\" bullet=\"$bullet\">\n";
}
if($para->[0]->{'text_visible'} == 1)
{
print OUT "<text>\n";
}
for(my $k = 1; $k <= $para->[0]->{'numSens'}; $k++)
{
$sentcount++;
if($para->[0]->{'sent_visible'} == 1)
{
print OUT "<Sentence id=\"".$para->[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 "</Sentence>\n";
}
}
if($para->[0]->{'text_visible'} == 1)
{
print OUT "</text>\n";
print OUT "<foreign language=\"select\" writingsystem=\"LTR\"></foreign>\n";
}
if($para->[0]->{'para_visible'} == 1)
{
print OUT "</tb>\n";
}
}
if($paras->[0]->{'body_visible'} == 1)
{
print OUT "</body>\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(<stdin>)
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<scalar(@$TreeRef)-1;$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";
}
return;
}
#% Prints the data structure to a file
#% print_tree_file($filename,[$tree]) -nil-
# $filename can be ">>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. <Deleted it>
}
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<index> that was passed to you.
{
$$TreeRef[$i]=$$TreeRef[$i+1];
}
pop(@$TreeRef); # Decrease the tree<array> 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. <As a double dimensional array>
}
#% 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;
modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti.pm deleted 100755 → 0
View file @ 5568b960
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;
modules/ILMT-KAN-HIN-ComputeVibhakti/lib/ILMT/KAN/HIN/ComputeVibhakti/ComputeTAM.pm deleted 100755 → 0
View file @ 5568b960
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;
server.json
View file @ e0d08a7a
{
"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"
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment