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

Annotation of /FigKernelPackages/Assignments.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (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 :     genome 198214.1 4 Shigella flexneri 2a str. 301
29 :     genome 198215.1 4 Shigella flexneri 2a str. 2457T
30 :     genome 216598.1 4 Shigella dysenteriae M131649
31 :     genome 216599.1 4 Shigella sonnei 53G
32 :     genome 630.2 4 Yersinia enterocolitica 8081
33 :     genome 633.2 4 Yersinia pseudotuberculosis (Livermore)
34 :     genome 187410.1 4 Yersinia pestis KIM
35 :     genome 214092.1 4 Yersinia pestis CO92
36 :     genome 229193.1 4 Yersinia pestis biovar Medievalis str. 91001
37 :     genome 273123.1 4 Yersinia pseudotuberculosis IP 32953
38 :     genome 594.1 4 Salmonella enterica subsp. enterica serovar Gallinarum
39 :     genome 99287.1 4 Salmonella typhimurium LT2
40 :     genome 119912.1 4 Salmonella enterica serovar Choleraesuis SC-B67
41 :     genome 209261.1 4 Salmonella enterica subsp. enterica serovar Typhi Ty2
42 :     genome 220341.1 4 Salmonella enterica subsp. enterica serovar Typhi str. CT18
43 :     genome 83333.1 4 Escherichia coli K12
44 :     genome 83334.1 4 Escherichia coli O157:H7
45 :     genome 155864.1 4 Escherichia coli O157:H7 EDL933
46 :     genome 199310.1 4 Escherichia coli CFT073
47 :     genome 216592.1 4 Escherichia coli 042
48 :     genome 216593.1 4 Escherichia coli E2348/69
49 :     genome 192222.1 4 Campylobacter jejuni subsp. jejuni NCTC 11168
50 :     genome 224308.1 2 Bacillus subtilis subsp. subtilis str. 168
51 :     external sp 4
52 : overbeek 1.3 external uni 1.3
53 : overbeek 1.1 external kegg 1
54 : overbeek 1.8 subsystems trusted 20
55 : overbeek 1.1 END
56 :     ;
57 : overbeek 1.10 my @parms = split(/\n/,$x);
58 :     my $fig = new FIG;
59 :     my @trusted_subsystems = map { my $sub = $_; my $curr = $fig->subsystem_curator($sub);
60 :     "$sub\t$curr\n"
61 :     }
62 :     grep { $fig->usable_subsystem($_) }
63 :     $fig->all_subsystems;
64 :     push(@parms,@trusted_subsystems,"//\n");
65 :     return @parms;
66 : overbeek 1.1 }
67 :    
68 : overbeek 1.3
69 : overbeek 1.1 sub choose_best_assignment {
70 : overbeek 1.9 my($fig,$parms,$pegs,$external_ids,$ignore) = @_;
71 : overbeek 1.1 my($peg,$id);
72 :    
73 :     my $functions = {};
74 :     foreach $peg (@$pegs)
75 :     {
76 :     &load_peg_function($fig,$parms,$peg,$functions);
77 :     }
78 : overbeek 1.9 my @tmp = keys(%$functions);
79 :     # print &Dumper(['peg check',\@tmp,$functions]);
80 :    
81 :     if ((@tmp == 1) && (@$pegs >= 5)) { return $tmp[0] }
82 : overbeek 1.1
83 :     foreach $id (@$external_ids)
84 :     {
85 :     &load_ext_function($fig,$parms,$id,$functions);
86 :     }
87 :    
88 :     return &cleanup(&pick_function($fig,$parms,$functions));
89 :     }
90 :    
91 :    
92 :     sub cleanup {
93 :     my($func) = @_;
94 :    
95 :     if (! $func) { return "hypothetical protein" }
96 :     if ($func =~ /^hypothetical (\S+ )?protein .*$/i) { return "hypothetical protein" }
97 :     if ($func =~ /^[a-zA-Z]{1,2}\d{2,5}( protein)?$/i) { return "hypothetical protein" }
98 : overbeek 1.5 if ($func =~ /^similar to ORF\d+$/) { return "hypothetical protein" }
99 :     if ($func =~ /^(Alr|As|All|Tlr|Tll|Glr|Blr|Slr|SEW|pANL)\d+( protein)?$/i) { return "hypothetical protein" }
100 : overbeek 1.6 if ($func =~ /^\d{5}/) { return "hypothetical protein" }
101 : overbeek 1.5 if ($func =~ /unknown protein/) { return "hypothetical protein" }
102 :    
103 : overbeek 1.1 return $func;
104 :     }
105 :    
106 :     sub pick_function {
107 :     my($fig,$parms,$functions) = @_;
108 :     my($set,$score,$best_source,$poss_function);
109 :     my(@scored);
110 :    
111 :     my @partitions = &SameFunc::group_funcs(keys(%$functions));
112 :     if ($ENV{'VERBOSE'}) { print STDERR "partition: ",&Dumper(\@partitions,$functions); }
113 :    
114 :     foreach $set (@partitions)
115 :     {
116 :     $score = &score_set($set,$functions);
117 :     # print STDERR &Dumper([$score,$set]);
118 :    
119 :     # print STDERR "picking from set ",&Dumper($set);
120 :     ($poss_function,$best_source) = &pick_specific($fig,$parms,$set,$functions);
121 : overbeek 1.7 # print STDERR "picked $poss_function from $best_source\n";
122 : overbeek 1.1 push(@scored,[$score,$poss_function,$best_source]);
123 :     }
124 :     @scored = sort { $b->[0] <=> $a->[0] } @scored;
125 :    
126 :     if ((@scored > 1) && $ENV{'VERBOSE'})
127 :     {
128 :     foreach $_ (@scored)
129 :     {
130 :     print STDERR join("\t",@$_),"\n";
131 :     }
132 :     print STDERR "//\n";
133 :     }
134 :     return (@scored > 0) ? $scored[0]->[1] : "";
135 :     }
136 :    
137 :     sub score_set {
138 :     my($set,$functions) = @_;
139 :     my($func,$x);
140 :    
141 :     my $score = 0;
142 :     foreach $func (@$set)
143 :     {
144 :     if ($x = $functions->{$func})
145 :     {
146 :     foreach $_ (@$x)
147 :     {
148 :     $score += $_->[0];
149 :     }
150 :     }
151 :     }
152 :     return $score;
153 :     }
154 :    
155 :     sub pick_specific {
156 :     my($fig,$parms,$set,$functions) = @_;
157 :     my($best_func,$best_score,$func,$x,$best_source);
158 :    
159 :     $best_func = "";
160 : overbeek 1.7 $best_score = 0;
161 : overbeek 1.1 $best_source = "";
162 :    
163 :     foreach $func (@$set)
164 :     {
165 :     if ($x = $functions->{$func})
166 :     {
167 :     my $incr = @$x;
168 :     foreach $_ (@$x)
169 :     {
170 : overbeek 1.3 my($sc,$peg,$in_sub) = @$_;
171 :     $sc += $in_sub ? 10000 : 0;
172 :    
173 :     if (((100 * $sc) + $incr) > $best_score)
174 : overbeek 1.1 {
175 : overbeek 1.3 $best_score = (100 * $sc) + $incr;
176 : overbeek 1.1 $best_func = $func;
177 : overbeek 1.3 $best_source = $peg;
178 : overbeek 1.1 }
179 :     }
180 :     }
181 :     }
182 :     if ($ENV{'VERBOSE'}) { print STDERR &Dumper(["picked best source",$set,$functions,$best_func,$best_source]) }
183 :     return ($best_func,$best_source);
184 :     }
185 :    
186 :     sub load_ext_function {
187 :     my($fig,$parms,$id,$functions) = @_;
188 :    
189 :     my $func = $fig->function_of($id);
190 :     if ($func && # (! &FIG::hypo($func)) &&
191 :     ($id =~ /^([A-Za-z]{2,4})\|/) && ($_ = $parms->{'external'}->{$1}))
192 :     {
193 :     push(@{$functions->{$func}},[$_,$id]);
194 :     }
195 :     }
196 :    
197 :     sub load_peg_function {
198 :     my($fig,$parms,$peg,$functions) = @_;
199 :    
200 :     my $func = $fig->function_of($peg);
201 :     if ($func) # (! &FIG::hypo($func))
202 :     {
203 :     my $value = 1;
204 :    
205 :     my $genome = &FIG::genome_of($peg);
206 :     if ($_ = $parms->{'genome'}->{$genome})
207 :     {
208 :     $value += $_;
209 :     }
210 :    
211 :     my $subv = 0;
212 :     my @subs = $fig->peg_to_subsystems($peg);
213 :     my $sub;
214 : overbeek 1.3 my $in_sub = 0;
215 : overbeek 1.1 foreach $sub (@subs)
216 :     {
217 : overbeek 1.3 if ($_ = $parms->{'subsystems'}->{$sub})
218 : overbeek 1.1 {
219 : overbeek 1.3 if ($_ > $subv)
220 :     {
221 :     $subv = $_;
222 :     }
223 :     $in_sub = 1;
224 : overbeek 1.1 }
225 :     }
226 :     $value += $subv;
227 : overbeek 1.3 push(@{$functions->{$func}},[$value,$peg,$in_sub]);
228 : overbeek 1.1 }
229 :     }
230 :    
231 :     sub equivalent_ids {
232 :     my($fig,$parms,$pegs) = @_;
233 :     my($peg,@aliases,$alias,%external_ids,%pegs,$tuple);
234 :    
235 :     foreach $peg (@$pegs)
236 :     {
237 :     $pegs{$peg} = 1;
238 :     @aliases = $fig->feature_aliases($peg);
239 :     foreach $alias (@aliases)
240 :     {
241 :     if (($alias =~ /^([A-Za-z]{2,4})\|\S+$/) && $parms->{"external"}->{$1})
242 :     {
243 :     $external_ids{$alias} = 1;
244 :     }
245 :     }
246 :     foreach $tuple ($fig->mapped_prot_ids($peg))
247 :     {
248 : overbeek 1.8 if (($tuple->[0] =~ /^fig\|/) && $fig->is_real_feature($tuple->[0]))
249 : overbeek 1.1 {
250 :     $pegs{$tuple->[0]} = 1;
251 :     }
252 :     elsif (($tuple->[0] =~ /^([A-Za-z]{2,4})\|\S+$/) && $parms->{"external"}->{$1})
253 :     {
254 :     $external_ids{$tuple->[0]} = 1;
255 :     }
256 :     }
257 :     }
258 :     return ([sort { &FIG::by_fig_id($a,$b) } keys(%pegs)],[sort keys(%external_ids)]);
259 :     }
260 :    
261 :     sub load_parms {
262 :     my($parmsF) = @_;
263 :     my @parmsS;
264 :    
265 :     my $wts = {};
266 :    
267 :     if ($parmsF)
268 :     {
269 :     @parmsS = `cat $parmsF`;
270 :     }
271 :     else
272 :     {
273 :     @parmsS = &default_parms;
274 :     }
275 :     while ($_ = shift @parmsS)
276 :     {
277 :     chomp;
278 :     my($type,$data,$val) = split(/\t/,$_);
279 :     if ($type eq 'subsystems')
280 :     {
281 :     my $x;
282 :     while (($x = shift @parmsS) && ($x !~ /^\/\//))
283 :     {
284 :     if ($x =~ /^(\S[^\t]+\S)/)
285 :     {
286 :     $wts->{$type}->{$1} = $val;
287 :     }
288 :     }
289 :     }
290 :     else
291 :     {
292 :     $wts->{$type}->{$data} = $val;
293 :     }
294 :     }
295 :     return $wts;
296 :     }
297 :    
298 :     sub print_parms {
299 :     my($parms) = @_;
300 :     my($type,$data,$val,$wt_by_type);
301 :    
302 :     print STDERR "Parameters:\n";
303 :     foreach $type (sort keys(%$parms))
304 :     {
305 :     print STDERR "\n\t$type\n";
306 :     $wt_by_type = $parms->{$type};
307 :     foreach $data (sort keys(%$wt_by_type))
308 :     {
309 :     $val = $wt_by_type->{$data};
310 :     print STDERR "\t\t$data\t$val\n";
311 :     }
312 :     }
313 :     print STDERR "\n";
314 :     }
315 :    
316 :    
317 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3