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

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (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 : overbeek 1.2 use Sim;
328 :     sub sims {
329 :     my($self,%args) = @_;
330 :    
331 :     my $figO = $self->{_figO};
332 :     my $fig = $figO->{_fig};
333 :    
334 :     my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
335 :     my $all = $args{-all} ? $args{-all} : "fig";
336 :     my $max = $args{-max} ? $args{-max} : 10000;
337 :    
338 :     return $fig->sims($self->id,$max,$cutoff,$all);
339 :     }
340 :    
341 :     sub bbhs {
342 :     my($self) = @_;
343 :    
344 :     my $figO = $self->{_figO};
345 :     my $fig = $figO->{_fig};
346 :    
347 :     my @bbhs = $fig->bbhs($self->id);
348 :     return map { my($peg2,$sc,$bs) = @$_; bless({ _peg1 => $self->id,
349 :     _peg2 => $peg2,
350 :     _psc => $sc,
351 :     _bit_score => $bs
352 :     },'BBHO') } @bbhs;
353 :     }
354 :    
355 : overbeek 1.1 sub display {
356 :     my($self) = @_;
357 :    
358 :     print join("\t",$self->id,$self->location,$self->function_of),"\n",
359 :     $self->dna_seq,"\n",
360 :     $self->prot_seq,"\n";
361 :     }
362 :    
363 : overbeek 1.2 package BBHO;
364 :    
365 :     sub new {
366 :     my($class,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
367 :    
368 :     my $self = {};
369 :     $self->{_peg1} = $peg1;
370 :     $self->{_peg2} = $peg2;
371 :     $self->{_psc} = $sc;
372 :     $self->{_bit_score} = $normalized_bitscore
373 :    
374 :     }
375 :    
376 :     sub peg1 {
377 :     my($self) = @_;
378 :    
379 :     return $self->{_peg1};
380 :     }
381 :    
382 :     sub peg2 {
383 :     my($self) = @_;
384 :    
385 :     return $self->{_peg2};
386 :     }
387 :    
388 :     sub psc {
389 :     my($self) = @_;
390 :    
391 :     return $self->{_psc};
392 :     }
393 :    
394 :     sub norm_bitscore {
395 :     my($self) = @_;
396 :    
397 :     return $self->{_bit_score};
398 :     }
399 :    
400 : overbeek 1.1 package AnnotationO;
401 :    
402 :     sub new {
403 :     my($class,$fid,$timestamp,$who,$text) = @_;
404 :    
405 :     my $self = {};
406 :     $self->{_fid} = $fid;
407 :     $self->{_timestamp} = $timestamp;
408 :     $self->{_who} = $who;
409 :     $self->{_text} = $text;
410 :     return bless $self, $class;
411 :     }
412 :    
413 :     sub fid {
414 :     my($self) = @_;
415 :    
416 :     return $self->{_fid};
417 :     }
418 :    
419 :     sub timestamp {
420 :     my($self,$convert) = @_;
421 :    
422 :     if ($convert)
423 :     {
424 :     return scalar localtime($self->{_timestamp});
425 :     }
426 :     else
427 :     {
428 :     return $self->{_timestamp};
429 :     }
430 :     }
431 :    
432 :     sub made_by {
433 :     my($self) = @_;
434 :    
435 :     my $who = $self->{_who};
436 :     $who =~ s/^master://i;
437 :     return $who;
438 :     }
439 :    
440 :     sub text {
441 :     my($self) = @_;
442 :    
443 :     my $text = $self->{_text};
444 :     return $text;
445 :     }
446 :    
447 :     sub display {
448 :     my($self) = @_;
449 :    
450 :     print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
451 :     }
452 :    
453 :     package CouplingO;
454 :    
455 :     use Data::Dumper;
456 :    
457 :     sub new {
458 :     my($class,$figO,$peg1,$peg2,$sc) = @_;
459 :    
460 :     ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
461 :     ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
462 :     my $self = {};
463 :     $self->{_figO} = $figO;
464 :     $self->{_peg1} = $peg1;
465 :     $self->{_peg2} = $peg2;
466 :     $self->{_sc} = $sc;
467 :     return bless $self, $class;
468 :     }
469 :    
470 :     sub peg1 {
471 :     my($self) = @_;
472 :    
473 :     return $self->{_peg1};
474 :     }
475 :    
476 :     sub peg2 {
477 :     my($self) = @_;
478 :    
479 :     return $self->{_peg2};
480 :     }
481 :    
482 :     sub sc {
483 :     my($self) = @_;
484 :    
485 :     return $self->{_sc};
486 :     }
487 :    
488 :     sub evidence {
489 :     my($self) = @_;
490 :    
491 :     my $figO = $self->{_figO};
492 :     my $fig = $figO->{_fig};
493 :     my @ev = ();
494 :     foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))
495 :     {
496 :     my($peg3,$peg4,$rep) = @$tuple;
497 :     push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
498 :     &FeatureO::new('FeatureO',$figO,$peg4),
499 :     $rep]);
500 :     }
501 :     return @ev;
502 :     }
503 :    
504 :     sub display {
505 :     my($self) = @_;
506 :    
507 :     print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
508 :     }
509 :    
510 :     package SubsystemO;
511 :    
512 :     use Data::Dumper;
513 :     use Subsystem;
514 :    
515 :     sub new {
516 :     my($class,$figO,$name) = @_;
517 :    
518 :     my $self = {};
519 :     $self->{_figO} = $figO;
520 :     $self->{_id} = $name;
521 :    
522 :     return bless $self, $class;
523 :     }
524 :    
525 :     sub id {
526 :     my($self) = @_;
527 :    
528 :     return $self->{_id};
529 :     }
530 :    
531 :     sub usable {
532 :     my($self) = @_;
533 :    
534 :     my $figO = $self->{_figO};
535 :     my $fig = $figO->{_fig};
536 :     return $fig->usable_subsystem($self->id);
537 :     }
538 :    
539 :     sub genomes {
540 :     my($self) = @_;
541 :    
542 :     my $figO = $self->{_figO};
543 :     my $subO = $self->{_subO};
544 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
545 :    
546 :     return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
547 :     }
548 :    
549 :     sub roles {
550 :     my($self) = @_;
551 :    
552 :     my $figO = $self->{_figO};
553 :     my $subO = $self->{_subO};
554 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
555 :    
556 :     return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) } $subO->get_roles($self->id);
557 :     }
558 :    
559 :     sub curator {
560 :     my($self) = @_;
561 :    
562 :     my $figO = $self->{_figO};
563 :     my $subO = $self->{_subO};
564 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
565 :    
566 :     return $subO->get_curator;
567 :     }
568 :    
569 :     sub variant {
570 :     my($self,$genome) = @_;
571 :    
572 :     my $figO = $self->{_figO};
573 :     my $subO = $self->{_subO};
574 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
575 :    
576 :     return $subO->get_variant_code_for_genome($genome->id);
577 :     }
578 :    
579 :     sub pegs_in_cell {
580 :     my($self,$genome,$role) = @_;
581 :    
582 :     my $figO = $self->{_figO};
583 :     my $subO = $self->{_subO};
584 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
585 :    
586 :     return $subO->get_pegs_from_cell($genome->id,$role->id);
587 :     }
588 :    
589 :     package FunctionalRoleO;
590 :    
591 :     use Data::Dumper;
592 :    
593 :     sub new {
594 :     my($class,$figO,$fr) = @_;
595 :    
596 :     my $self = {};
597 :     $self->{_figO} = $figO;
598 :     $self->{_id} = $fr;
599 :     return bless $self, $class;
600 :     }
601 :    
602 :     sub id {
603 :     my($self) = @_;
604 :    
605 :     return $self->{_id};
606 :     }
607 :    
608 :     package FigFamO;
609 :    
610 :     use FigFams;
611 :     use FigFam;
612 :    
613 :     sub new {
614 :     my($class,$figO,$id) = @_;
615 :    
616 :     my $self = {};
617 :     $self->{_figO} = $figO;
618 :     $self->{_id} = $id;
619 :     return bless $self, $class;
620 :     }
621 :    
622 :     sub id {
623 :     my($self) = @_;
624 :    
625 :     return $self->{_id};
626 :     }
627 :    
628 :     sub function {
629 :     my($self) = @_;
630 :    
631 :     my $fig = $self->{_figO}->{_fig};
632 :     my $famO = $self->{_famO};
633 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
634 :    
635 :     return $famO->family_function;
636 :     }
637 :    
638 :     sub members {
639 :     my($self) = @_;
640 :    
641 :     my $figO = $self->{_figO};
642 :     my $fig = $figO->{_fig};
643 :     my $famO = $self->{_famO};
644 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
645 :    
646 :     return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;
647 :     }
648 :    
649 :     sub rep_seqs {
650 :     my($self) = @_;
651 :    
652 :     my $figO = $self->{_figO};
653 :     my $fig = $figO->{_fig};
654 :     my $famO = $self->{_famO};
655 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
656 :    
657 :     return $famO->representatives;
658 :     }
659 :    
660 :     sub should_be_member {
661 :     my($self,$seq) = @_;
662 :    
663 :     my $figO = $self->{_figO};
664 :     my $fig = $figO->{_fig};
665 :     my $famO = $self->{_famO};
666 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
667 :    
668 :     return $famO->should_be_member($seq);
669 :     }
670 :    
671 :    
672 :    
673 :     sub display {
674 :     my($self) = @_;
675 :    
676 :     print join("\t",($self->id,$self->function)),"\n";
677 :     }
678 :    
679 :    
680 :    
681 :     package Attribute;
682 :    
683 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3