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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3