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

Annotation of /FigKernelScripts/initialize_ann_and_ev.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download) (as text)

1 : overbeek 1.1
2 :     $usage = "usage: initialize_attr_and_ev Dir";
3 :    
4 :     (
5 :     ($dir = shift @ARGV)
6 :     )
7 :     || die $usage;
8 :    
9 :     if (-s "$dir/assigned_functions")
10 :     {
11 :     &create_ann($dir,"assigned_functions","from original annotations",0);
12 :     }
13 :    
14 : olson 1.3 if (-s "$dir/proposed_functions")
15 : overbeek 1.1 {
16 : olson 1.3 &create_ann($dir,"proposed_functions","based on FIGfams",1);
17 : overbeek 1.1 }
18 :    
19 : olson 1.3 if (-s "$dir/proposed_non_ff_functions")
20 : overbeek 1.1 {
21 : olson 1.3 &create_ann($dir,"proposed_non_ff_functions","based on unreliable automated assignments",2);
22 : overbeek 1.1 }
23 :    
24 :     &create_ev_attributes($dir);
25 :    
26 :     sub create_ann
27 :     {
28 :     my($dir,$file,$note,$delta) = @_;
29 :    
30 :     if (open(ANN,">>$dir/annotations") && open(ASSIGN,"<$dir/$file"))
31 :     {
32 :     $now = time;
33 :     $ts = int($now + $delta - (24 * 60 * 60 * (-M $file)));
34 :    
35 :     while (defined($_ = <ASSIGN>))
36 :     {
37 :     if ($_ =~ /^(\S+\.peg\.\d+)\t(\S.*\S)/)
38 :     {
39 :     print ANN join("\n",($1,$ts,"rapid_propogation","Set function to",$2,$note)),"\n//\n";
40 :     }
41 :     }
42 :     close(ASSIGN);
43 :     close(ANN);
44 :     }
45 :     }
46 :    
47 :     sub create_ev_attributes {
48 :     my($dir) = @_;
49 :     my($i,$j,$sub);
50 :    
51 :     my %found = map { ($_ =~ /^(\S+)/) ? ($1 => 1) : () } `cut -f1 $dir/found`;
52 :    
53 :     if (open(BINDINGS,"<$dir/Subsystems/bindings") &&
54 :     open(TBL,"<$dir/Features/peg/tbl") &&
55 :     open(ATTR,">$dir/evidence.codes"))
56 :     {
57 :     my %by_contig;
58 :     while (defined($_ = <TBL>))
59 :     {
60 :     if ($_ =~ /^(\S+)\t(\S+)_(\d+)_(\d+)\s/)
61 :     {
62 :     push(@{$by_contig{$2}},[$1,($3 + $4) / 2]);
63 :     }
64 :     }
65 :     close(TBL);
66 :    
67 :     my %close;
68 :     foreach $contig (keys(%by_contig))
69 :     {
70 :     my $x = $by_contig{$contig};
71 :     my @entries = sort { $a->[1] <=> $b->[1] } @$x;
72 :     for ($i=0; ($i < @entries); $i++)
73 :     {
74 :     my $close = [];
75 :     my($peg,$loc) = @{$entries[$i]};
76 :     for ($j=$i-1; ($j >= 0) && (($loc - $entries[$j]->[1]) <= 5000); $j--)
77 :     {
78 :     push(@$close,$entries[$j]->[0]);
79 :     }
80 :     for ($j=$i+1; ($j < @entries) && (($entries[$j]->[1] - $loc) <= 5000); $j++)
81 :     {
82 :     push(@$close,$entries[$j]->[0]);
83 :     }
84 :     $close{$peg} = $close;
85 :     }
86 :     }
87 :    
88 :     while (defined($_ = <BINDINGS>))
89 :     {
90 :     chop;
91 :     my($sub,$role,$peg) = split(/\t/,$_);
92 :     $hash{$sub}->{$role}->{$peg} = 1;
93 :     }
94 :     close(BINDINGS);
95 :    
96 :     foreach $sub (keys(%hash))
97 :     {
98 :     my $roleH = $hash{$sub};
99 :     my(%idu,%isu,%icw,%in_sub);
100 :    
101 :     foreach my $role (keys(%$roleH))
102 :     {
103 :     my $pegH = $roleH->{$role};
104 :     my @pegs = keys(%$pegH);
105 :    
106 :     foreach my $peg (@pegs)
107 :     {
108 :     if (@pegs > 1)
109 :     {
110 :     $idu{$peg} = @pegs - 1;
111 :     }
112 :     else
113 :     {
114 :     $isu{$peg} = 1;
115 :     }
116 :     $in_sub{$peg} = 1;
117 :     }
118 :    
119 :     foreach my $peg (@pegs)
120 :     {
121 :     delete($found{$peg});
122 :     my $x = $close{$peg};
123 :    
124 :     for ($i=0,$icw=0; ($i < @$x); $i++)
125 :     {
126 :     if ($in_sub{$x->[$i]}) { $icw++; }
127 :     }
128 :     if ($icw > 0)
129 :     {
130 :     print ATTR "$peg\ticw($icw);$sub\n";
131 :     }
132 :     elsif ($isu{$peg})
133 :     {
134 :     print ATTR "$peg\tisu;$sub\n";
135 :     }
136 :     else
137 :     {
138 :     print ATTR "$peg\tidu($idu{$peg});$sub\n";
139 :     }
140 :     }
141 :     }
142 :     }
143 :     foreach $peg (keys(%found))
144 :     {
145 :     print ATTR "$peg\tff\n";
146 :     }
147 :     close(ATTR);
148 :     }
149 :     }
150 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3