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

Annotation of /FigKernelPackages/FIGV.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : overbeek 1.1 #
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 :     package FIGV;
19 :    
20 :     use strict;
21 :     use FIG;
22 :     use FIG_Config;
23 :     use SFXlate;
24 :     use SproutFIG;
25 :     use Tracer;
26 :     use Data::Dumper;
27 :    
28 :     sub new {
29 :     my($class,$org_dir,$low_level) = @_;
30 :    
31 :     my $fig;
32 :     if ($low_level && ($low_level =~ /sprout/i))
33 :     {
34 :     $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
35 :     }
36 :     else
37 :     {
38 :     $fig = new FIG;
39 :     }
40 :    
41 :     my $self = {};
42 :     $self->{_fig} = $fig;
43 :     $self->{_orgdir} = $org_dir;
44 :    
45 :     $org_dir =~ /(\d+\.\d+)$/;
46 :     $self->{_genome} = $1;
47 :     return bless $self, $class;
48 :     }
49 :    
50 :     sub genomes {
51 :     my($self,$complete) = @_;
52 :     my $fig = $self->{_fig};
53 :    
54 :     return ($self->{_genome},$fig->genomes($complete));
55 :     }
56 :    
57 :     sub genus_species {
58 :     my($self,$genome) = @_;
59 :    
60 :     my $fig = $self->{_fig};
61 :     my $newG = $self->{_genome};
62 :     my $newGdir = $self->{_orgdir};
63 :    
64 :     if (($genome eq $newG) && open(GENOME,"<$newGdir/GENOME"))
65 :     {
66 :     my $x = <GENOME>;
67 :     close(GENOME);
68 :     chop $x;
69 :     return $x;
70 :     }
71 :     else
72 :     {
73 :     return $fig->genus_species($genome);
74 :     }
75 :     }
76 :    
77 :     sub feature_location {
78 :     my($self,$fid) = @_;
79 :    
80 :     my $fig = $self->{_fig};
81 :     my $newG = $self->{_genome};
82 :     my $newGdir = $self->{_orgdir};
83 :    
84 :     if (($fid =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
85 :     {
86 :     &load_tbl($self);
87 :     if (my $x = $self->{_tbl}->{$fid})
88 :     {
89 :     return join(",",@{$x->[0]});
90 :     }
91 :     else
92 :     {
93 :     return undef;
94 :     }
95 :     }
96 :     else
97 :     {
98 :     return scalar $fig->feature_location($fid);
99 :     }
100 :     }
101 :    
102 :     sub function_of {
103 :     my($self,$fid) = @_;
104 :    
105 :     my $fig = $self->{_fig};
106 :     my $newG = $self->{_genome};
107 :     my $newGdir = $self->{_orgdir};
108 :    
109 :     if (($fid =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
110 :     {
111 :     &load_functions($self);
112 :     return $self->{_functions}->{$fid};
113 :     }
114 :     else
115 :     {
116 :     return scalar $fig->function_of($fid);
117 :     }
118 :     }
119 :    
120 :     sub feature_aliases {
121 :     my($self,$fid) = @_;
122 :    
123 :     my $fig = $self->{_fig};
124 :     my $newG = $self->{_genome};
125 :     my $newGdir = $self->{_orgdir};
126 :    
127 :     my @aliases;
128 :     if (($fid =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
129 :     {
130 :     &load_tbl($self);
131 :     if (my $x = $self->{_tbl}->{$fid})
132 :     {
133 :     @aliases = @{$x->[1]};
134 :     }
135 :     else
136 :     {
137 :     @aliases = ();
138 :     }
139 :     }
140 :     else
141 :     {
142 :     @aliases = $fig->feature_aliases($fid);
143 :     }
144 :     return wantarray() ? @aliases : join(",",@aliases);
145 :     }
146 :    
147 :     sub feature_annotations {
148 :     my($self,$fid,$rawtime) = @_;
149 :    
150 :     my $fig = $self->{_fig};
151 :     my $newG = $self->{_genome};
152 :     my $newGdir = $self->{_orgdir};
153 :    
154 :     my @annotations;
155 :     if (($fid =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
156 :     {
157 :     &load_ann($self);
158 :     if (my $x = $self->{_ann}->{$fid})
159 :     {
160 :     @annotations = @{$x};
161 :     }
162 :     else
163 :     {
164 :     @annotations = ();
165 :     }
166 :    
167 :     if ($rawtime)
168 :     {
169 :     return @annotations;
170 :     }
171 :     else
172 :     {
173 :     return map { $_->[1] = localtime($_->[1]); $_ } @annotations;
174 :     }
175 :     }
176 :     else
177 :     {
178 :     return $fig->feature_annotations($fid);
179 :     }
180 :     }
181 :    
182 :     sub get_translation {
183 :     my($self,$peg) = @_;
184 :    
185 :     my $fig = $self->{_fig};
186 :     my $newG = $self->{_genome};
187 :     my $newGdir = $self->{_orgdir};
188 :    
189 :     if (($peg =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
190 :     {
191 :     &load_pseq($self);
192 :     return $self->{_pseq}->{$peg};
193 :     }
194 :     else
195 :     {
196 :     return $fig->get_translation($peg);
197 :     }
198 :     }
199 :    
200 :     sub load_pseq {
201 :     my($self) = @_;
202 :    
203 :     if ($self->{_pseq}) { return };
204 :    
205 :     my $newGdir = $self->{_orgdir};
206 :     my $pseq = {};
207 :     if (open(FASTA,"<$newGdir/Features/peg/fasta"))
208 :     {
209 :     $/ = "\n>";
210 :     my $x;
211 :     while (defined($x = <FASTA>))
212 :     {
213 :     if ($x =~ /^>?(\S+)[^\n]*\n(.*)/)
214 :     {
215 :     my $peg = $1;
216 :     my $seq = $2;
217 :     $seq =~ s/\s//gs;
218 :     $pseq->{$peg} = $seq;
219 :     }
220 :     }
221 :     close(FASTA);
222 :     $/ = "\n";
223 :     }
224 :     $self->{_pseq} = $pseq;
225 :     }
226 :    
227 :     sub load_tbl {
228 :     my($self) = @_;
229 :    
230 :     if ($self->{_tbl}) { return };
231 :    
232 :     my $newGdir = $self->{_orgdir};
233 :     my $tbl = {};
234 :     foreach my $x (`cat $newGdir/Features/*/tbl`)
235 :     {
236 :     if ($x =~ /^(\S+)\t(\S+)(\t(\S.*\S))?/)
237 :     {
238 :     my $fid = $1;
239 :     my $loc = [split(/,/,$2)];
240 :     my $aliases = $4 ? [split(/\t/,@$4)] : [];
241 :     $tbl->{$fid} = [$loc,$aliases];
242 :     }
243 :     }
244 :     $self->{_tbl} = $tbl;
245 :     }
246 :    
247 :     sub load_functions {
248 :     my($self) = @_;
249 :    
250 :     if ($self->{_functions}) { return };
251 :    
252 :     my $newG = $self->{_genome};
253 :     my $newGdir = $self->{_orgdir};
254 :    
255 :     my $functions = {};
256 :     foreach my $x (`cat $newGdir/*functions`)
257 :     {
258 :     if (($x =~ /^(fig\|(\d+\.\d+)\.\S+)\t(\S[^\t]*\S)/) && ($2 eq $newG))
259 :     {
260 :     $functions->{$1} = $3;
261 :     }
262 :     }
263 :     $self->{_functions} = $functions;
264 :     }
265 :    
266 :     sub sims {
267 :     my($self,$peg,$max,$maxP,$select) = @_;
268 :    
269 :     my $fig = $self->{_fig};
270 :     my $newG = $self->{_genome};
271 :     my $newGdir = $self->{_orgdir};
272 :     my $max = $max ? $max : 10000;
273 :     my $maxP = $maxP ? $maxP : 1.0e-5;
274 :     $select = $select ? $select : "all";
275 :    
276 :     if (($peg =~ /^fig\|(\d+\.\d+)/) && ($1 eq $newG))
277 :     {
278 :     &load_sims($self);
279 :     my @sims = ();
280 :     my $raw_sims = $self->{_sims}->{$peg};
281 :     if ($raw_sims)
282 :     {
283 :     foreach my $sim ( grep { $_->[10] <= $maxP } @$raw_sims )
284 :     {
285 :     my $id2 = $sim->id2;
286 :     my $id1 = $sim->id1;
287 :     my @relevant = ();
288 :    
289 :     my @maps_to = $fig->mapped_prot_ids( $id2 );
290 :     my $ref_len = $maps_to[0]->[1];
291 :    
292 :     @maps_to = grep { $_->[0] !~ /^xxx\d+/ } @maps_to;
293 :    
294 :     if ( $select =~ /^figx?$/ ) # Only fig
295 :     {
296 :     @relevant = grep { $_->[0] =~ /^fig/ } @maps_to;
297 :     }
298 :     else # All
299 :     {
300 :     @relevant = @maps_to;
301 :     }
302 :    
303 :     my $seen = {};
304 :     foreach my $x ( @relevant )
305 :     {
306 :     my ( $x_id, $x_ln ) = @$x;
307 :    
308 :     next if $seen->{$x_id};
309 :     $seen->{$x_id} = 1;
310 :    
311 :     my $delta2 = $ref_len - $x_ln; # Coordinate shift
312 :     my $sim1 = [ @$sim ]; # Make a copy
313 :     $sim1->[1] = $x_id;
314 :     $sim1->[8] -= $delta2;
315 :     $sim1->[9] -= $delta2;
316 :     bless( $sim1, "Sim" );
317 :     push( @sims, $sim1 );
318 :     }
319 :     }
320 :     }
321 :    
322 :     if (@sims > $max) { $#sims = $max-1; }
323 :     return @sims;
324 :     }
325 :     else
326 :     {
327 :     return $fig->sims($peg,$max,$maxP,$select);
328 :     }
329 :     }
330 :    
331 :     sub load_sims {
332 :     my($self) = @_;
333 :    
334 :     if ($self->{_sims}) { return };
335 :    
336 :     my $newGdir = $self->{_orgdir};
337 :    
338 :     my $sims = {};
339 :     foreach my $x (`cat $newGdir/similarities`)
340 :     {
341 :     chop; $x;
342 :     if ($x =~ /^(\S+)/)
343 :     {
344 :     push(@{$sims->{$1}},bless([split(/\t/,$x)],'Sim'));
345 :     }
346 :     }
347 :     $self->{_sims} = $sims;
348 :     }
349 :    
350 :     sub get_attributes {
351 :     my($self,$peg) = @_;
352 :    
353 :     my $fig = $self->{_fig};
354 :     my $newG = $self->{_genome};
355 :     my $newGdir = $self->{_orgdir};
356 :    
357 :     if (($peg =~ /^fig\|(\d+\.\d+)\.peg\.\d+$/) && ($1 eq $newG))
358 :     {
359 :     &load_attr($self);
360 :     if (my $x = $self->{_attr}->{$peg})
361 :     {
362 :     return @$x;
363 :     }
364 :     else
365 :     {
366 :     return ();
367 :     }
368 :     }
369 :     else
370 :     {
371 :     return $fig->get_attributes($peg);
372 :     }
373 :     }
374 :    
375 :     sub load_attr {
376 :     my($self) = @_;
377 :    
378 :     if ($self->{_attr}) { return };
379 :    
380 :     my $newGdir = $self->{_orgdir};
381 :     my $attr = {};
382 :     foreach my $x (`cat $newGdir/Subsystems/attributes`)
383 :     {
384 :     if ($x =~ /^(\S+)\t(\S+)/)
385 :     {
386 :     push(@{$attr->{$1}},[$1,"evidence_code",$2,""]);
387 :     }
388 :     }
389 :     $self->{_attr} = $attr;
390 :     }
391 :    
392 :     sub load_ann {
393 :     my($self) = @_;
394 :    
395 :     if ($self->{_ann}) { return };
396 :    
397 :     my $newGdir = $self->{_orgdir};
398 :     my $ann = {};
399 :     if (open(ANN,"<$newGdir/annotations"))
400 :     {
401 :     $/ = "\n//\n";
402 :     while (defined(my $x = <ANN>))
403 :     {
404 :     chomp $x;
405 :     if ($x =~ /^(\S+)\n([^\n]+)\n([^\n]+)\n(.*)/s)
406 :     {
407 :     push(@{$ann->{$1}},[$1,$2,$3,"$4\n"]);
408 :     }
409 :     }
410 :     $/ = "\n";
411 :     close(ANN);
412 :     }
413 :     $self->{_ann} = $ann;
414 :     }
415 :    
416 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3