[Bio] / FigKernelPackages / Assignments.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/Assignments.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.4 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : overbeek 1.1 package Assignments;
19 :    
20 :     use Carp;
21 :     use Data::Dumper;
22 :     use FIG;
23 :     use SameFunc;
24 :    
25 :     sub default_parms {
26 :    
27 :     my $x = <<END
28 :     external sp 4
29 : overbeek 1.17 external img 4
30 : overbeek 1.3 external uni 1.3
31 : overbeek 1.1 external kegg 1
32 : overbeek 1.17 external gi 1
33 : overbeek 1.1 END
34 :     ;
35 : overbeek 1.17 #
36 :     # TO PUT FIG ANNOTATIONS BACK IN ADD THE FOLLOWING LINE
37 :     #######################################################
38 :     #subsystems trusted 20
39 :     #######################################################
40 :     # You may also improve things by adding lines like:
41 :     #
42 :     #genome 83333.1 15 Escherichia coli K12
43 :     #
44 :     #######################################################
45 :    
46 : overbeek 1.10 my @parms = split(/\n/,$x);
47 :     my $fig = new FIG;
48 :     my @trusted_subsystems = map { my $sub = $_; my $curr = $fig->subsystem_curator($sub);
49 :     "$sub\t$curr\n"
50 :     }
51 :     grep { $fig->usable_subsystem($_) }
52 :     $fig->all_subsystems;
53 :     push(@parms,@trusted_subsystems,"//\n");
54 :     return @parms;
55 : overbeek 1.1 }
56 :    
57 : overbeek 1.3
58 : overbeek 1.1 sub choose_best_assignment {
59 : overbeek 1.9 my($fig,$parms,$pegs,$external_ids,$ignore) = @_;
60 : overbeek 1.1 my($peg,$id);
61 :    
62 :     my $functions = {};
63 :     foreach $peg (@$pegs)
64 :     {
65 :     &load_peg_function($fig,$parms,$peg,$functions);
66 :     }
67 : overbeek 1.9 my @tmp = keys(%$functions);
68 : overbeek 1.13 print STDERR &Dumper(['peg check',\@tmp,$functions]) if ($ENV{'DEBUG'} || $ENV{'VERBOSE'});
69 : overbeek 1.9
70 :     if ((@tmp == 1) && (@$pegs >= 5)) { return $tmp[0] }
71 : overbeek 1.1
72 :     foreach $id (@$external_ids)
73 :     {
74 :     &load_ext_function($fig,$parms,$id,$functions);
75 :     }
76 :    
77 :     return &cleanup(&pick_function($fig,$parms,$functions));
78 :     }
79 :    
80 :    
81 :     sub cleanup {
82 :     my($func) = @_;
83 :    
84 :     if (! $func) { return "hypothetical protein" }
85 :     if ($func =~ /^hypothetical (\S+ )?protein .*$/i) { return "hypothetical protein" }
86 :     if ($func =~ /^[a-zA-Z]{1,2}\d{2,5}( protein)?$/i) { return "hypothetical protein" }
87 : overbeek 1.5 if ($func =~ /^similar to ORF\d+$/) { return "hypothetical protein" }
88 :     if ($func =~ /^(Alr|As|All|Tlr|Tll|Glr|Blr|Slr|SEW|pANL)\d+( protein)?$/i) { return "hypothetical protein" }
89 : overbeek 1.6 if ($func =~ /^\d{5}/) { return "hypothetical protein" }
90 : overbeek 1.5 if ($func =~ /unknown protein/) { return "hypothetical protein" }
91 :    
92 : overbeek 1.1 return $func;
93 :     }
94 :    
95 :     sub pick_function {
96 :     my($fig,$parms,$functions) = @_;
97 :     my($set,$score,$best_source,$poss_function);
98 :     my(@scored);
99 :     my @partitions = &SameFunc::group_funcs(keys(%$functions));
100 :     if ($ENV{'VERBOSE'}) { print STDERR "partition: ",&Dumper(\@partitions,$functions); }
101 :    
102 :     foreach $set (@partitions)
103 :     {
104 :     $score = &score_set($set,$functions);
105 : overbeek 1.12 if ($ENV{'DEBUG'}) { print STDERR &Dumper([$score,$set]); }
106 : overbeek 1.1
107 : overbeek 1.12 if ($ENV{'DEBUG'}) { print STDERR "picking from set ",&Dumper($set); }
108 : overbeek 1.1 ($poss_function,$best_source) = &pick_specific($fig,$parms,$set,$functions);
109 : overbeek 1.12 if ($ENV{'DEBUG'}) { print STDERR "picked $poss_function from $best_source\n"; }
110 : overbeek 1.1 push(@scored,[$score,$poss_function,$best_source]);
111 :     }
112 :     @scored = sort { $b->[0] <=> $a->[0] } @scored;
113 :    
114 :     if ((@scored > 1) && $ENV{'VERBOSE'})
115 :     {
116 :     foreach $_ (@scored)
117 :     {
118 :     print STDERR join("\t",@$_),"\n";
119 :     }
120 :     print STDERR "//\n";
121 :     }
122 :     return (@scored > 0) ? $scored[0]->[1] : "";
123 :     }
124 :    
125 :     sub score_set {
126 :     my($set,$functions) = @_;
127 :     my($func,$x);
128 :    
129 :     my $score = 0;
130 :     foreach $func (@$set)
131 :     {
132 :     if ($x = $functions->{$func})
133 :     {
134 :     foreach $_ (@$x)
135 :     {
136 :     $score += $_->[0];
137 :     }
138 :     }
139 :     }
140 :     return $score;
141 :     }
142 :    
143 :     sub pick_specific {
144 :     my($fig,$parms,$set,$functions) = @_;
145 :     my($best_func,$best_score,$func,$x,$best_source);
146 :    
147 :     $best_func = "";
148 : overbeek 1.7 $best_score = 0;
149 : overbeek 1.1 $best_source = "";
150 :    
151 :     foreach $func (@$set)
152 :     {
153 :     if ($x = $functions->{$func})
154 :     {
155 :     my $incr = @$x;
156 :     foreach $_ (@$x)
157 :     {
158 : overbeek 1.3 my($sc,$peg,$in_sub) = @$_;
159 :     $sc += $in_sub ? 10000 : 0;
160 :    
161 :     if (((100 * $sc) + $incr) > $best_score)
162 : overbeek 1.1 {
163 : overbeek 1.3 $best_score = (100 * $sc) + $incr;
164 : overbeek 1.1 $best_func = $func;
165 : overbeek 1.3 $best_source = $peg;
166 : overbeek 1.1 }
167 :     }
168 :     }
169 :     }
170 :     if ($ENV{'VERBOSE'}) { print STDERR &Dumper(["picked best source",$set,$functions,$best_func,$best_source]) }
171 :     return ($best_func,$best_source);
172 :     }
173 :    
174 :     sub load_ext_function {
175 :     my($fig,$parms,$id,$functions) = @_;
176 :    
177 :     my $func = $fig->function_of($id);
178 :     if ($func && # (! &FIG::hypo($func)) &&
179 :     ($id =~ /^([A-Za-z]{2,4})\|/) && ($_ = $parms->{'external'}->{$1}))
180 :     {
181 :     push(@{$functions->{$func}},[$_,$id]);
182 :     }
183 :     }
184 :    
185 :     sub load_peg_function {
186 :     my($fig,$parms,$peg,$functions) = @_;
187 :    
188 :     my $func = $fig->function_of($peg);
189 :     if ($func) # (! &FIG::hypo($func))
190 :     {
191 :     my $value = 1;
192 :    
193 :     my $genome = &FIG::genome_of($peg);
194 :     if ($_ = $parms->{'genome'}->{$genome})
195 :     {
196 :     $value += $_;
197 :     }
198 :     my $subv = 0;
199 : overbeek 1.13 my @subs = ();
200 :     foreach my $sub ($fig->peg_to_subsystems($peg))
201 :     {
202 : overbeek 1.14 if (1) # (&solid_sub_assign($fig,$sub,$peg,$func))
203 : overbeek 1.13 {
204 :     push(@subs,$sub);
205 :     }
206 :     }
207 : overbeek 1.1 my $sub;
208 : overbeek 1.3 my $in_sub = 0;
209 : overbeek 1.1 foreach $sub (@subs)
210 :     {
211 : overbeek 1.3 if ($_ = $parms->{'subsystems'}->{$sub})
212 : overbeek 1.1 {
213 : overbeek 1.3 if ($_ > $subv)
214 :     {
215 :     $subv = $_;
216 :     }
217 :     $in_sub = 1;
218 : overbeek 1.1 }
219 :     }
220 :     $value += $subv;
221 : overbeek 1.3 push(@{$functions->{$func}},[$value,$peg,$in_sub]);
222 : overbeek 1.1 }
223 :     }
224 :    
225 : overbeek 1.13 sub solid_sub_assign {
226 :     my($fig,$sub,$peg,$func) = @_;
227 :    
228 :     my $curator = $fig->subsystem_curator($sub);
229 :     $curator =~ s/^master://;
230 :     return ($fig->usable_subsystem($sub) && &made_by_curator($fig,$peg,$func,$curator));
231 :     }
232 :    
233 :     sub made_by_curator {
234 :     my($fig,$peg,$func,$curator) = @_;
235 :    
236 :     my @ann = $fig->feature_annotations($peg,"rawtime");
237 :     my $i;
238 :     my $funcQ = quotemeta $func;
239 :     for ($i=$#ann;
240 :     ($i >= 0) && (($ann[$i]->[2] !~ /$curator/) || ($ann[$i]->[3] !~ /Set \S+ function to\n$funcQ/s));
241 :     $i--) {}
242 :     return ($i >= 0);
243 :     }
244 :    
245 : overbeek 1.1 sub equivalent_ids {
246 :     my($fig,$parms,$pegs) = @_;
247 :     my($peg,@aliases,$alias,%external_ids,%pegs,$tuple);
248 :    
249 :     foreach $peg (@$pegs)
250 :     {
251 :     $pegs{$peg} = 1;
252 :     @aliases = $fig->feature_aliases($peg);
253 :     foreach $alias (@aliases)
254 :     {
255 :     if (($alias =~ /^([A-Za-z]{2,4})\|\S+$/) && $parms->{"external"}->{$1})
256 :     {
257 :     $external_ids{$alias} = 1;
258 :     }
259 :     }
260 :     foreach $tuple ($fig->mapped_prot_ids($peg))
261 :     {
262 : overbeek 1.8 if (($tuple->[0] =~ /^fig\|/) && $fig->is_real_feature($tuple->[0]))
263 : overbeek 1.1 {
264 :     $pegs{$tuple->[0]} = 1;
265 :     }
266 :     elsif (($tuple->[0] =~ /^([A-Za-z]{2,4})\|\S+$/) && $parms->{"external"}->{$1})
267 :     {
268 :     $external_ids{$tuple->[0]} = 1;
269 :     }
270 :     }
271 :     }
272 :     return ([sort { &FIG::by_fig_id($a,$b) } keys(%pegs)],[sort keys(%external_ids)]);
273 :     }
274 :    
275 :     sub load_parms {
276 :     my($parmsF) = @_;
277 :     my @parmsS;
278 :    
279 :     my $wts = {};
280 :    
281 :     if ($parmsF)
282 :     {
283 :     @parmsS = `cat $parmsF`;
284 :     }
285 :     else
286 :     {
287 :     @parmsS = &default_parms;
288 :     }
289 :     while ($_ = shift @parmsS)
290 :     {
291 :     chomp;
292 :     my($type,$data,$val) = split(/\t/,$_);
293 :     if ($type eq 'subsystems')
294 :     {
295 :     my $x;
296 :     while (($x = shift @parmsS) && ($x !~ /^\/\//))
297 :     {
298 :     if ($x =~ /^(\S[^\t]+\S)/)
299 :     {
300 :     $wts->{$type}->{$1} = $val;
301 :     }
302 :     }
303 :     }
304 :     else
305 :     {
306 :     $wts->{$type}->{$data} = $val;
307 :     }
308 :     }
309 :     return $wts;
310 :     }
311 :    
312 :     sub print_parms {
313 :     my($parms) = @_;
314 :     my($type,$data,$val,$wt_by_type);
315 :    
316 :     print STDERR "Parameters:\n";
317 :     foreach $type (sort keys(%$parms))
318 :     {
319 :     print STDERR "\n\t$type\n";
320 :     $wt_by_type = $parms->{$type};
321 :     foreach $data (sort keys(%$wt_by_type))
322 :     {
323 :     $val = $wt_by_type->{$data};
324 :     print STDERR "\t\t$data\t$val\n";
325 :     }
326 :     }
327 :     print STDERR "\n";
328 :     }
329 :    
330 :    
331 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3