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

Annotation of /FigKernelPackages/FIGO.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 FIGO;
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 :     use FigFams;
28 :    
29 :     sub new {
30 :     my($class,$low_level) = @_;
31 :    
32 :     my $fig;
33 :     if ($low_level && ($low_level =~ /sprout/i))
34 :     {
35 :     $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
36 :     }
37 :     else
38 :     {
39 :     $fig = new FIG;
40 :     }
41 :    
42 :     my $self = {};
43 :     $self->{_fig} = $fig;
44 :     return bless $self, $class;
45 :     }
46 :    
47 :     sub genomes {
48 :     my($self,@constraints) = @_;
49 :     my $fig = $self->{_fig};
50 :    
51 :     my %constraints = map { $_ => 1 } @constraints;
52 :     my @genomes = ();
53 :    
54 :     if ($constraints{complete})
55 :     {
56 :     @genomes = $fig->genomes('complete');
57 :     }
58 :     else
59 :     {
60 :     @genomes = $fig->genomes;
61 :     }
62 :    
63 :     if ($constraints{prokaryotic})
64 :     {
65 :     @genomes = grep { $fig->is_prokaryotic($_) } @genomes;
66 :     }
67 :    
68 :     if ($constraints{eukaryotic})
69 :     {
70 :     @genomes = grep { $fig->is_eukaryotic($_) } @genomes;
71 :     }
72 :    
73 :     if ($constraints{bacterial})
74 :     {
75 :     @genomes = grep { $fig->is_bacterial($_) } @genomes;
76 :     }
77 :    
78 :     if ($constraints{archaeal})
79 :     {
80 :     @genomes = grep { $fig->is_archaeal($_) } @genomes;
81 :     }
82 :    
83 :     if ($constraints{nmpdr})
84 :     {
85 :     @genomes = grep { $fig->is_NMPDR_genome($_) } @genomes;
86 :     }
87 :    
88 :     return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
89 :     }
90 :    
91 :     sub subsystems {
92 :     my($self) = @_;
93 :     my $fig = $self->{_fig};
94 :    
95 :     return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
96 :     }
97 :    
98 :     sub functional_roles {
99 :     my($self) = @_;
100 :     my $fig = $self->{_fig};
101 :    
102 :     my @functional_roles = ();
103 :    
104 :     return @functional_roles;
105 :     }
106 :    
107 :     sub all_figfams {
108 :     my($self) = @_;
109 :     my $fig = $self->{_fig};
110 :     my $fams = new FigFams($fig);
111 :     return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
112 :     }
113 :    
114 :     sub family_containing {
115 :     my($self,$seq) = @_;
116 :    
117 :     my $fig = $self->{_fig};
118 :     my $fams = new FigFams($fig);
119 :     my($fam,$sims) = $fams->place_in_family($seq);
120 :     if ($fam)
121 :     {
122 :     return (&FigFamO::new('FigFamO',$self,$fam->family_id),$sims);
123 :     }
124 :     else
125 :     {
126 :     return undef;
127 :     }
128 :     }
129 :    
130 :     package GenomeO;
131 :    
132 :     use Data::Dumper;
133 :    
134 :     sub new {
135 :     my($class,$figO,$genomeId) = @_;
136 :    
137 :     my $self = {};
138 :     $self->{_figO} = $figO;
139 :     $self->{_id} = $genomeId;
140 :     return bless $self, $class;
141 :     }
142 :    
143 :     sub id {
144 :     my($self) = @_;
145 :    
146 :     return $self->{_id};
147 :     }
148 :    
149 :     sub genus_species {
150 :     my($self) = @_;
151 :    
152 :     my $fig = $self->{_figO}->{_fig};
153 :     return $fig->genus_species($self->{_id});
154 :     }
155 :    
156 :     sub contigs_of {
157 :     my($self) = @_;
158 :    
159 :     my $figO = $self->{_figO};
160 :     my $fig = $figO->{_fig};
161 :     return map { &ContigO::new('ContigO',$figO,$self->id,$_) } $fig->contigs_of($self->id);
162 :     }
163 :    
164 :     sub features_of {
165 :     my($self,$type) = @_;
166 :    
167 :     my $figO = $self->{_figO};
168 :     my $fig = $figO->{_fig};
169 :    
170 :     return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
171 :     }
172 :    
173 :     sub display {
174 :     my($self) = @_;
175 :    
176 :     print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
177 :     }
178 :    
179 :     package ContigO;
180 :    
181 :     use Data::Dumper;
182 :    
183 :     sub new {
184 :     my($class,$figO,$genomeId,$contigId) = @_;
185 :    
186 :     my $self = {};
187 :     $self->{_figO} = $figO;
188 :     $self->{_id} = $contigId;
189 :     $self->{_genome} = $genomeId;
190 :     return bless $self, $class;
191 :     }
192 :    
193 :     sub id {
194 :     my($self) = @_;
195 :    
196 :     return $self->{_id};
197 :     }
198 :    
199 :     sub genome {
200 :     my($self) = @_;
201 :    
202 :     return $self->{_genome};
203 :     }
204 :    
205 :     sub contig_length {
206 :     my($self) = @_;
207 :    
208 :     my $fig = $self->{_figO}->{_fig};
209 :     my $contig_lengths = $fig->contig_lengths($self->genome);
210 :     return $contig_lengths->{$self->id};
211 :     }
212 :    
213 :     sub dna_seq {
214 :     my($self,$beg,$end) = @_;
215 :    
216 :     my $fig = $self->{_figO}->{_fig};
217 :     my $max = $self->contig_length;
218 :     if (($beg && (&FIG::between(1,$beg,$max))) &&
219 :     ($end && (&FIG::between(1,$end,$max))))
220 :     {
221 :     return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));
222 :     }
223 :     else
224 :     {
225 :     return undef;
226 :     }
227 :     }
228 :    
229 :     sub display {
230 :     my($self) = @_;
231 :    
232 :     print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";
233 :     }
234 :    
235 :     package FeatureO;
236 :    
237 :     use Data::Dumper;
238 :    
239 :     sub new {
240 :     my($class,$figO,$fid) = @_;
241 :    
242 :     ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
243 :     my $self = {};
244 :     $self->{_figO} = $figO;
245 :     $self->{_id} = $fid;
246 :     return bless $self, $class;
247 :     }
248 :    
249 :     sub id {
250 :     my($self) = @_;
251 :    
252 :     return $self->{_id};
253 :     }
254 :    
255 :     sub genome {
256 :     my($self) = @_;
257 :    
258 :     $self->id =~ /^fig\|(\d+\.\d+)/;
259 :     return $1;
260 :     }
261 :    
262 :     sub type {
263 :     my($self) = @_;
264 :    
265 :     $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
266 :     return $1;
267 :     }
268 :    
269 :     sub location {
270 :     my($self) = @_;
271 :    
272 :     my $fig = $self->{_figO}->{_fig};
273 :     return scalar $fig->feature_location($self->id);
274 :     }
275 :    
276 :     sub dna_seq {
277 :     my($self) = @_;
278 :    
279 :     my $fig = $self->{_figO}->{_fig};
280 :     my $fid = $self->id;
281 :     my @loc = $fig->feature_location($fid);
282 :     return $fig->dna_seq(&FIG::genome_of($fid),@loc);
283 :     }
284 :    
285 :     sub prot_seq {
286 :     my($self) = @_;
287 :    
288 :     ($self->type eq "peg") || return undef;
289 :     my $fig = $self->{_figO}->{_fig};
290 :     my $fid = $self->id;
291 :     return $fig->get_translation($fid);
292 :     }
293 :    
294 :     sub function_of {
295 :     my($self) = @_;
296 :    
297 :     my $fig = $self->{_figO}->{_fig};
298 :     my $fid = $self->id;
299 :     return scalar $fig->function_of($fid);
300 :     }
301 :    
302 :     sub coupled_to {
303 :     my($self) = @_;
304 :    
305 :     ($self->type eq "peg") || return undef;
306 :     my $figO = $self->{_figO};
307 :     my $fig = $figO->{_fig};
308 :     my $peg1 = $self->id;
309 :     my @coupled = ();
310 :     foreach my $tuple ($fig->coupled_to($peg1))
311 :     {
312 :     my($peg2,$sc) = @$tuple;
313 :     push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));
314 :     }
315 :     return @coupled;
316 :     }
317 :    
318 :     sub annotations {
319 :     my($self) = @_;
320 :    
321 :     my $figO = $self->{_figO};
322 :     my $fig = $figO->{_fig};
323 :    
324 :     return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
325 :     }
326 :    
327 :     sub display {
328 :     my($self) = @_;
329 :    
330 :     print join("\t",$self->id,$self->location,$self->function_of),"\n",
331 :     $self->dna_seq,"\n",
332 :     $self->prot_seq,"\n";
333 :     }
334 :    
335 :     package AnnotationO;
336 :    
337 :     sub new {
338 :     my($class,$fid,$timestamp,$who,$text) = @_;
339 :    
340 :     my $self = {};
341 :     $self->{_fid} = $fid;
342 :     $self->{_timestamp} = $timestamp;
343 :     $self->{_who} = $who;
344 :     $self->{_text} = $text;
345 :     return bless $self, $class;
346 :     }
347 :    
348 :     sub fid {
349 :     my($self) = @_;
350 :    
351 :     return $self->{_fid};
352 :     }
353 :    
354 :     sub timestamp {
355 :     my($self,$convert) = @_;
356 :    
357 :     if ($convert)
358 :     {
359 :     return scalar localtime($self->{_timestamp});
360 :     }
361 :     else
362 :     {
363 :     return $self->{_timestamp};
364 :     }
365 :     }
366 :    
367 :     sub made_by {
368 :     my($self) = @_;
369 :    
370 :     my $who = $self->{_who};
371 :     $who =~ s/^master://i;
372 :     return $who;
373 :     }
374 :    
375 :     sub text {
376 :     my($self) = @_;
377 :    
378 :     my $text = $self->{_text};
379 :     return $text;
380 :     }
381 :    
382 :     sub display {
383 :     my($self) = @_;
384 :    
385 :     print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
386 :     }
387 :    
388 :     package CouplingO;
389 :    
390 :     use Data::Dumper;
391 :    
392 :     sub new {
393 :     my($class,$figO,$peg1,$peg2,$sc) = @_;
394 :    
395 :     ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
396 :     ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
397 :     my $self = {};
398 :     $self->{_figO} = $figO;
399 :     $self->{_peg1} = $peg1;
400 :     $self->{_peg2} = $peg2;
401 :     $self->{_sc} = $sc;
402 :     return bless $self, $class;
403 :     }
404 :    
405 :     sub peg1 {
406 :     my($self) = @_;
407 :    
408 :     return $self->{_peg1};
409 :     }
410 :    
411 :     sub peg2 {
412 :     my($self) = @_;
413 :    
414 :     return $self->{_peg2};
415 :     }
416 :    
417 :     sub sc {
418 :     my($self) = @_;
419 :    
420 :     return $self->{_sc};
421 :     }
422 :    
423 :     sub evidence {
424 :     my($self) = @_;
425 :    
426 :     my $figO = $self->{_figO};
427 :     my $fig = $figO->{_fig};
428 :     my @ev = ();
429 :     foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))
430 :     {
431 :     my($peg3,$peg4,$rep) = @$tuple;
432 :     push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
433 :     &FeatureO::new('FeatureO',$figO,$peg4),
434 :     $rep]);
435 :     }
436 :     return @ev;
437 :     }
438 :    
439 :     sub display {
440 :     my($self) = @_;
441 :    
442 :     print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
443 :     }
444 :    
445 :     package SubsystemO;
446 :    
447 :     use Data::Dumper;
448 :     use Subsystem;
449 :    
450 :     sub new {
451 :     my($class,$figO,$name) = @_;
452 :    
453 :     my $self = {};
454 :     $self->{_figO} = $figO;
455 :     $self->{_id} = $name;
456 :    
457 :     return bless $self, $class;
458 :     }
459 :    
460 :     sub id {
461 :     my($self) = @_;
462 :    
463 :     return $self->{_id};
464 :     }
465 :    
466 :     sub usable {
467 :     my($self) = @_;
468 :    
469 :     my $figO = $self->{_figO};
470 :     my $fig = $figO->{_fig};
471 :     return $fig->usable_subsystem($self->id);
472 :     }
473 :    
474 :     sub genomes {
475 :     my($self) = @_;
476 :    
477 :     my $figO = $self->{_figO};
478 :     my $subO = $self->{_subO};
479 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
480 :    
481 :     return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
482 :     }
483 :    
484 :     sub roles {
485 :     my($self) = @_;
486 :    
487 :     my $figO = $self->{_figO};
488 :     my $subO = $self->{_subO};
489 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
490 :    
491 :     return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) } $subO->get_roles($self->id);
492 :     }
493 :    
494 :     sub curator {
495 :     my($self) = @_;
496 :    
497 :     my $figO = $self->{_figO};
498 :     my $subO = $self->{_subO};
499 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
500 :    
501 :     return $subO->get_curator;
502 :     }
503 :    
504 :     sub variant {
505 :     my($self,$genome) = @_;
506 :    
507 :     my $figO = $self->{_figO};
508 :     my $subO = $self->{_subO};
509 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
510 :    
511 :     return $subO->get_variant_code_for_genome($genome->id);
512 :     }
513 :    
514 :     sub pegs_in_cell {
515 :     my($self,$genome,$role) = @_;
516 :    
517 :     my $figO = $self->{_figO};
518 :     my $subO = $self->{_subO};
519 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
520 :    
521 :     return $subO->get_pegs_from_cell($genome->id,$role->id);
522 :     }
523 :    
524 :     package FunctionalRoleO;
525 :    
526 :     use Data::Dumper;
527 :    
528 :     sub new {
529 :     my($class,$figO,$fr) = @_;
530 :    
531 :     my $self = {};
532 :     $self->{_figO} = $figO;
533 :     $self->{_id} = $fr;
534 :     return bless $self, $class;
535 :     }
536 :    
537 :     sub id {
538 :     my($self) = @_;
539 :    
540 :     return $self->{_id};
541 :     }
542 :    
543 :     package FigFamO;
544 :    
545 :     use FigFams;
546 :     use FigFam;
547 :    
548 :     sub new {
549 :     my($class,$figO,$id) = @_;
550 :    
551 :     my $self = {};
552 :     $self->{_figO} = $figO;
553 :     $self->{_id} = $id;
554 :     return bless $self, $class;
555 :     }
556 :    
557 :     sub id {
558 :     my($self) = @_;
559 :    
560 :     return $self->{_id};
561 :     }
562 :    
563 :     sub function {
564 :     my($self) = @_;
565 :    
566 :     my $fig = $self->{_figO}->{_fig};
567 :     my $famO = $self->{_famO};
568 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
569 :    
570 :     return $famO->family_function;
571 :     }
572 :    
573 :     sub members {
574 :     my($self) = @_;
575 :    
576 :     my $figO = $self->{_figO};
577 :     my $fig = $figO->{_fig};
578 :     my $famO = $self->{_famO};
579 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
580 :    
581 :     return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;
582 :     }
583 :    
584 :     sub rep_seqs {
585 :     my($self) = @_;
586 :    
587 :     my $figO = $self->{_figO};
588 :     my $fig = $figO->{_fig};
589 :     my $famO = $self->{_famO};
590 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
591 :    
592 :     return $famO->representatives;
593 :     }
594 :    
595 :     sub should_be_member {
596 :     my($self,$seq) = @_;
597 :    
598 :     my $figO = $self->{_figO};
599 :     my $fig = $figO->{_fig};
600 :     my $famO = $self->{_famO};
601 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
602 :    
603 :     return $famO->should_be_member($seq);
604 :     }
605 :    
606 :    
607 :    
608 :     sub display {
609 :     my($self) = @_;
610 :    
611 :     print join("\t",($self->id,$self->function)),"\n";
612 :     }
613 :    
614 :    
615 :    
616 :     package Attribute;
617 :    
618 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3