[Bio] / FigKernelScripts / initialize_ann_and_ev.pl Repository:
ViewVC logotype

View of /FigKernelScripts/initialize_ann_and_ev.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (download) (as text) (annotate)
Mon Feb 18 21:37:12 2008 UTC (11 years, 9 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, rast_rel_2008_11_24, rast_rel_2008_08_07
Changes since 1.2: +4 -6 lines
undo bogus commit

$usage = "usage: initialize_attr_and_ev Dir";

(
 ($dir = shift @ARGV)
)
    || die $usage;

if (-s "$dir/assigned_functions")
{ 
    &create_ann($dir,"assigned_functions","from original annotations",0); 
}

if (-s "$dir/proposed_functions")
{ 
    &create_ann($dir,"proposed_functions","based on FIGfams",1); 
}

if (-s "$dir/proposed_non_ff_functions")
{ 
    &create_ann($dir,"proposed_non_ff_functions","based on unreliable automated assignments",2); 
}

&create_ev_attributes($dir);

sub create_ann 
{
    my($dir,$file,$note,$delta) = @_;

    if (open(ANN,">>$dir/annotations") && open(ASSIGN,"<$dir/$file"))
    {
	$now = time;
	$ts = int($now + $delta - (24 * 60 * 60 * (-M $file)));

	while (defined($_ = <ASSIGN>))
	{
	    if ($_ =~ /^(\S+\.peg\.\d+)\t(\S.*\S)/)
	    {
		print ANN join("\n",($1,$ts,"rapid_propogation","Set function to",$2,$note)),"\n//\n";
	    }
	}
	close(ASSIGN);
	close(ANN);
    }
}

sub create_ev_attributes {
    my($dir) = @_;
    my($i,$j,$sub);

    my %found = map { ($_ =~ /^(\S+)/) ? ($1 => 1) : () } `cut -f1 $dir/found`;

    if (open(BINDINGS,"<$dir/Subsystems/bindings") && 
	open(TBL,"<$dir/Features/peg/tbl") &&
	open(ATTR,">$dir/evidence.codes"))
    {
	my %by_contig;
	while (defined($_ = <TBL>))
	{
	    if ($_ =~ /^(\S+)\t(\S+)_(\d+)_(\d+)\s/)
	    {
		push(@{$by_contig{$2}},[$1,($3 + $4) / 2]);
	    }
	}
	close(TBL);

	my %close;
	foreach $contig (keys(%by_contig))
	{
	    my $x = $by_contig{$contig};
	    my @entries = sort { $a->[1] <=> $b->[1] } @$x;
	    for ($i=0; ($i < @entries); $i++)
	    {
		my $close = [];
		my($peg,$loc) = @{$entries[$i]};
		for ($j=$i-1; ($j >= 0) && (($loc - $entries[$j]->[1]) <= 5000); $j--)
		{
		    push(@$close,$entries[$j]->[0]);
		}
		for ($j=$i+1; ($j < @entries) && (($entries[$j]->[1] - $loc) <= 5000); $j++)
		{
		    push(@$close,$entries[$j]->[0]);
		}
		$close{$peg} = $close;
	    }
	}

	while (defined($_ = <BINDINGS>))
	{
	    chop;
	    my($sub,$role,$peg) = split(/\t/,$_);
	    $hash{$sub}->{$role}->{$peg} = 1;
	}
	close(BINDINGS);

	foreach $sub (keys(%hash))
	{
	    my $roleH = $hash{$sub};
	    my(%idu,%isu,%icw,%in_sub);

	    foreach my $role (keys(%$roleH))
	    {
		my $pegH = $roleH->{$role};
		my @pegs = keys(%$pegH);

		foreach my $peg (@pegs)
		{
		    if (@pegs > 1) 
		    {
			$idu{$peg} = @pegs - 1;
		    }
		    else
		    {
			$isu{$peg} = 1;
		    }
		    $in_sub{$peg} = 1;
		}

		foreach my $peg (@pegs)
		{
		    delete($found{$peg});
		    my $x = $close{$peg};

		    for ($i=0,$icw=0; ($i < @$x); $i++)
		    {
			if ($in_sub{$x->[$i]}) { $icw++; }
		    }
		    if ($icw > 0)
		    {
			print ATTR "$peg\ticw($icw);$sub\n";
		    }
		    elsif ($isu{$peg})
		    {
			print ATTR "$peg\tisu;$sub\n";
		    }
		    else
		    {
			print ATTR "$peg\tidu($idu{$peg});$sub\n";
		    }
		}
	    }
	}
	foreach $peg (keys(%found))
	{
	    print ATTR "$peg\tff\n";
	}
	close(ATTR);
    }
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3