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

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : overbeek 1.9 ########################################################################
2 : overbeek 1.1 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 : overbeek 1.9 ########################################################################
19 :    
20 :     =head1 Overview
21 :    
22 :     This module is a set of packages encapsulating the SEED's core methods
23 :     using an "OOP-like" style.
24 :    
25 :     There are several modules clearly related to "individual genomes:"
26 :     FIGO, GenomeO, ContigO, FeatureO (and I<maybe> AnnotationO).
27 :    
28 :     There are also modules that deal with complex relationships between
29 :     pairs or sets of features in one, two, or more genomes,
30 :     rather than any particular single genome:
31 :     BBHO, CouplingO, SubsystemO, FunctionalRoleO, FigFamO.
32 :    
33 :     Finally, the methods in "Attribute" might in principle attach
34 :     "atributes" to any type of object.
35 :     (Likewise, in principle one might like to attach an "annotation"
36 :     to any type of object
37 :    
38 :     Four of the modules dealing with "genomes" have a reasonable clear
39 :     "implied heirarchy:"
40 :    
41 :     =over 4
42 :    
43 :     FIGO > GenomeO > ContigO > FeatureO
44 :    
45 :     =back
46 : overbeek 1.1
47 : overbeek 1.9 However, inheritance is B<NOT> implemented using the C<@ISA> mechanism,
48 :     because some methods deal with "pairwise" or "setwise" relations between objects
49 :     or other more complex relationships that do not naturally fit into any heirarchy ---
50 :     which would get us into the whole quagmire of "multiple inheritance."
51 :    
52 :     We have chosen to sidestep the entire issue of inheritance via an I<ad hoc> mechanism:
53 :     If a "child" object needs access to its "ancestors'" methods,
54 :     we pass it references to its "ancestors" using subroutine arguments.
55 :     This is admittedly ugly, clumsy, and potentially error-prone ---
56 :     but it has the advantage that, unlike multiple inheritance,
57 :     we understand how to do it...
58 :    
59 :     MODULE DEPENDENCIES: FIG, FIG_Config, FigFams, SFXlate, SproutFIG, Tracer,
60 :     gjoparseblast, Data::Dumper.
61 :    
62 :     =cut
63 :    
64 :     ########################################################################
65 : overbeek 1.1 package FIGO;
66 : overbeek 1.9 ########################################################################
67 : overbeek 1.1 use strict;
68 :     use FIG;
69 :     use FIG_Config;
70 :     use SFXlate;
71 :     use SproutFIG;
72 :     use Tracer;
73 :     use Data::Dumper;
74 :     use FigFams;
75 : overbeek 1.3 use gjoparseblast;
76 : overbeek 1.1
77 : overbeek 1.9 =head1 FIGO
78 :    
79 :     The effective "base class" containing a few "top-level" methods.
80 :    
81 :     =cut
82 :    
83 : overbeek 1.4
84 :     =head3 new
85 :    
86 :     Constructs a new FIGO object.
87 :    
88 : overbeek 1.9 =over 4
89 : overbeek 1.4
90 :     =item USAGE:
91 :    
92 :     C<< my $figo = FIGO->new(); #...Subclass defaults to FIG >>
93 :    
94 :     C<< my $figo = FIGO->new('SPROUT'); #...Subclass is a SPROUT object >>
95 :    
96 :     =back
97 :    
98 :     =cut
99 :    
100 : overbeek 1.1 sub new {
101 :     my($class,$low_level) = @_;
102 :    
103 :     my $fig;
104 :     if ($low_level && ($low_level =~ /sprout/i))
105 :     {
106 :     $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
107 :     }
108 :     else
109 :     {
110 :     $fig = new FIG;
111 :     }
112 :    
113 :     my $self = {};
114 :     $self->{_fig} = $fig;
115 : overbeek 1.3 $self->{_tmp_dir} = $FIG_Config::temp;
116 : overbeek 1.1 return bless $self, $class;
117 :     }
118 :    
119 : overbeek 1.4
120 :    
121 :     =head3 genomes
122 :    
123 :     Returns a list of Taxonomy-IDs, possibly constrained by selection criteria.
124 :     (Default: Empty constraint returns all Tax-IDs in the SEED or SPROUT.)
125 :    
126 : overbeek 1.9 =over 4
127 : overbeek 1.4
128 :     =item USAGE:
129 :    
130 :     C<< my @tax_ids = $figo->genomes(); >>
131 :    
132 :     C<< my @tax_ids = $figo->genomes( @constraints ); >>
133 :    
134 :     =item @constraints
135 : overbeek 1.9
136 :     One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
137 : overbeek 1.4
138 :     =item RETURNS: List of Tax-IDs.
139 :    
140 : overbeek 1.9 =item EXAMPLE:
141 :    
142 :     L<Display all complete, prokaryotic genomes>
143 : overbeek 1.4
144 :     =back
145 :    
146 :     =cut
147 :    
148 : overbeek 1.1 sub genomes {
149 :     my($self,@constraints) = @_;
150 :     my $fig = $self->{_fig};
151 :    
152 :     my %constraints = map { $_ => 1 } @constraints;
153 :     my @genomes = ();
154 :    
155 :     if ($constraints{complete})
156 :     {
157 :     @genomes = $fig->genomes('complete');
158 :     }
159 :     else
160 :     {
161 :     @genomes = $fig->genomes;
162 :     }
163 :    
164 :     if ($constraints{prokaryotic})
165 :     {
166 :     @genomes = grep { $fig->is_prokaryotic($_) } @genomes;
167 :     }
168 :    
169 :     if ($constraints{eukaryotic})
170 :     {
171 :     @genomes = grep { $fig->is_eukaryotic($_) } @genomes;
172 :     }
173 :    
174 :     if ($constraints{bacterial})
175 :     {
176 :     @genomes = grep { $fig->is_bacterial($_) } @genomes;
177 :     }
178 :    
179 :     if ($constraints{archaeal})
180 :     {
181 :     @genomes = grep { $fig->is_archaeal($_) } @genomes;
182 :     }
183 :    
184 :     if ($constraints{nmpdr})
185 :     {
186 :     @genomes = grep { $fig->is_NMPDR_genome($_) } @genomes;
187 :     }
188 :    
189 :     return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
190 :     }
191 :    
192 : overbeek 1.4
193 :    
194 :     =head3 subsystems
195 :    
196 : overbeek 1.9 =over 4
197 : overbeek 1.4
198 :     =item RETURNS:
199 :    
200 : overbeek 1.9 List of all subsystems.
201 :    
202 :     =item EXAMPLE:
203 :    
204 :     L<Accessing Subsystem data>
205 : overbeek 1.4
206 :     =back
207 :    
208 :     =cut
209 :    
210 : overbeek 1.1 sub subsystems {
211 :     my($self) = @_;
212 :     my $fig = $self->{_fig};
213 :    
214 :     return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
215 :     }
216 :    
217 : overbeek 1.4
218 :     =head3 functional_roles
219 :    
220 :     (Not yet implemented)
221 :    
222 : overbeek 1.9 =over
223 : overbeek 1.4
224 :     =item RETURNS:
225 :    
226 :     =item EXAMPLE:
227 :    
228 :     =back
229 :    
230 :     =cut
231 :    
232 : overbeek 1.1 sub functional_roles {
233 :     my($self) = @_;
234 :     my $fig = $self->{_fig};
235 :    
236 :     my @functional_roles = ();
237 :    
238 :     return @functional_roles;
239 :     }
240 :    
241 : overbeek 1.4
242 :    
243 :     =head3 all_figfams
244 :    
245 :     Returns a list of all FIGfam objects.
246 :    
247 : overbeek 1.9 =over 4
248 :    
249 :     =item USAGE:
250 :    
251 :     C<< foreach $fam ($figO->all_figfams) { #...Do something } >>
252 :    
253 :     =item RETURNS:
254 : overbeek 1.4
255 : overbeek 1.9 List of FIGfam Objects
256 : overbeek 1.4
257 : overbeek 1.9 =item EXAMPLE:
258 : overbeek 1.4
259 : overbeek 1.9 L<Accessing FIGfams>
260 : overbeek 1.4
261 :     =back
262 :    
263 :     =cut
264 :    
265 : overbeek 1.1 sub all_figfams {
266 :     my($self) = @_;
267 :     my $fig = $self->{_fig};
268 :     my $fams = new FigFams($fig);
269 :     return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
270 :     }
271 :    
272 : overbeek 1.4
273 :    
274 :     =head3 family_containing
275 :    
276 : overbeek 1.9 =over 4
277 : overbeek 1.4
278 : overbeek 1.9 =item USAGE:
279 : overbeek 1.4
280 : overbeek 1.9 C<< my ($fam, $sims) = $figO->family_containing($seq); >>
281 : overbeek 1.4
282 : overbeek 1.9 =item $seq:
283 :    
284 :     A protein translation string.
285 :    
286 :     =item RETURNS:
287 :    
288 : overbeek 1.4 $fam: A FIGfam Object.
289 : overbeek 1.9
290 : overbeek 1.4 $sims: A set of similarity objects.
291 :    
292 :     =item EXAMPLE: L<Placing a sequence into a FIGfam>
293 :    
294 :     =back
295 :    
296 :     =cut
297 :    
298 : overbeek 1.1 sub family_containing {
299 :     my($self,$seq) = @_;
300 :    
301 :     my $fig = $self->{_fig};
302 :     my $fams = new FigFams($fig);
303 :     my($fam,$sims) = $fams->place_in_family($seq);
304 :     if ($fam)
305 :     {
306 :     return (&FigFamO::new('FigFamO',$self,$fam->family_id),$sims);
307 :     }
308 :     else
309 :     {
310 :     return undef;
311 :     }
312 :     }
313 :    
314 : overbeek 1.4
315 :     ########################################################################
316 : overbeek 1.1 package GenomeO;
317 : overbeek 1.4 ########################################################################
318 :     use Data::Dumper;
319 :    
320 :     =head1 GenomeO
321 :    
322 :     =cut
323 :    
324 :     =head3 new
325 :    
326 :     Constructor of GenomeO objects.
327 : overbeek 1.1
328 : overbeek 1.9 =over 4
329 : overbeek 1.4
330 :     =item USAGE:
331 :    
332 : overbeek 1.9 C<< my $org = GenomeO->new($figo, $tax_id); >>
333 :    
334 :     =item RETURNS:
335 :    
336 :     A new GenomeO object.
337 : overbeek 1.4
338 :     =back
339 :    
340 :     =cut
341 : overbeek 1.1
342 :     sub new {
343 :     my($class,$figO,$genomeId) = @_;
344 :    
345 :     my $self = {};
346 :     $self->{_figO} = $figO;
347 :     $self->{_id} = $genomeId;
348 :     return bless $self, $class;
349 :     }
350 :    
351 : overbeek 1.4
352 :    
353 :     =head3 id
354 :    
355 : overbeek 1.9 =over 4
356 :    
357 :     =item USAGE:
358 : overbeek 1.4
359 : overbeek 1.9 C<< my $tax_id = $org->id(); >>
360 :    
361 :     =item RETURNS:
362 : overbeek 1.4
363 : overbeek 1.9 Taxonomy-ID of GenomeO object.
364 : overbeek 1.4
365 :     =back
366 :    
367 :     =cut
368 :    
369 : overbeek 1.1 sub id {
370 :     my($self) = @_;
371 :    
372 :     return $self->{_id};
373 :     }
374 :    
375 : overbeek 1.4
376 :    
377 :     =head3 genus_species
378 :    
379 : overbeek 1.9 =over 4
380 : overbeek 1.4
381 : overbeek 1.9 =item USAGE:
382 :    
383 :     C<< $gs = $genome->genus_species(); >>
384 :    
385 :     =item RETURNS:
386 : overbeek 1.4
387 : overbeek 1.9 Genus-species-strain string
388 : overbeek 1.4
389 :     =back
390 :    
391 :     =cut
392 :    
393 : overbeek 1.1 sub genus_species {
394 :     my($self) = @_;
395 :    
396 :     my $fig = $self->{_figO}->{_fig};
397 :     return $fig->genus_species($self->{_id});
398 :     }
399 :    
400 : overbeek 1.4
401 :     =head3 contigs_of
402 :    
403 : overbeek 1.9 =over 4
404 :    
405 :     =item RETURNS:
406 :    
407 :     List of C<contig> objects contained in a C<GenomeO> object.
408 : overbeek 1.4
409 : overbeek 1.9 =item EXAMPLE:
410 : overbeek 1.4
411 : overbeek 1.9 L<Show how to access contigs and extract sequence>
412 : overbeek 1.4
413 :     =back
414 :    
415 :     =cut
416 :    
417 : overbeek 1.1 sub contigs_of {
418 :     my($self) = @_;
419 :    
420 :     my $figO = $self->{_figO};
421 :     my $fig = $figO->{_fig};
422 :     return map { &ContigO::new('ContigO',$figO,$self->id,$_) } $fig->contigs_of($self->id);
423 :     }
424 :    
425 : overbeek 1.4
426 :    
427 :     =head3 features_of
428 :    
429 :     =cut
430 :    
431 : overbeek 1.1 sub features_of {
432 :     my($self,$type) = @_;
433 :    
434 :     my $figO = $self->{_figO};
435 :     my $fig = $figO->{_fig};
436 :    
437 :     return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
438 :     }
439 :    
440 : overbeek 1.4
441 :     =head3 display
442 :    
443 :     Prints the genus, species, and strain information about a genome to STDOUT.
444 :    
445 : overbeek 1.9 =over 4
446 :    
447 :     =item USAGE:
448 :    
449 :     C<< $genome->display(); >>
450 : overbeek 1.4
451 : overbeek 1.9 =item RETURNS:
452 : overbeek 1.4
453 : overbeek 1.9 (Void)
454 : overbeek 1.4
455 :     =back
456 :    
457 :     =cut
458 :    
459 : overbeek 1.1 sub display {
460 :     my($self) = @_;
461 :    
462 :     print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
463 :     }
464 :    
465 : overbeek 1.4
466 :    
467 :     ########################################################################
468 : overbeek 1.1 package ContigO;
469 : overbeek 1.4 ########################################################################
470 :     use Data::Dumper;
471 :    
472 :     =head1 ContigO
473 :    
474 :     Methods for working with DNA sequence objects.
475 :    
476 :     =cut
477 :    
478 :     =head3 new
479 :    
480 :     Contig constructor.
481 : overbeek 1.1
482 : overbeek 1.9 =over 4
483 : overbeek 1.4
484 :     =item USAGE:
485 :    
486 : overbeek 1.9 C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>
487 : overbeek 1.4
488 : overbeek 1.9 =item $figO:
489 : overbeek 1.4
490 : overbeek 1.9 Parent FIGO object.
491 : overbeek 1.4
492 : overbeek 1.9 =item $genomeId:
493 :    
494 :     Taxon-ID for the genome the contig is from.
495 :    
496 :     =item $contigId:
497 :    
498 :     Identifier for the contig
499 :    
500 :     =item RETURNS:
501 :    
502 :     A "ContigO" object.
503 : overbeek 1.4
504 :     =back
505 :    
506 :     =cut
507 : overbeek 1.1
508 :     sub new {
509 :     my($class,$figO,$genomeId,$contigId) = @_;
510 :    
511 :     my $self = {};
512 :     $self->{_figO} = $figO;
513 :     $self->{_id} = $contigId;
514 :     $self->{_genome} = $genomeId;
515 :     return bless $self, $class;
516 :     }
517 :    
518 : overbeek 1.4
519 :    
520 :     =head3 id
521 :    
522 : overbeek 1.9 =over 4
523 : overbeek 1.4
524 : overbeek 1.9 =item RETURNS:
525 :    
526 :     Sequence ID string of "ContigO" object
527 : overbeek 1.4
528 :     =back
529 :    
530 :     =cut
531 :    
532 : overbeek 1.1 sub id {
533 :     my($self) = @_;
534 :    
535 :     return $self->{_id};
536 :     }
537 :    
538 : overbeek 1.4
539 :     =head3 genome
540 :    
541 : overbeek 1.9 =over 4
542 : overbeek 1.4
543 : overbeek 1.9 =item USAGE:
544 :    
545 : overbeek 1.11 C<< my $tax_id = $contig->genome->id(); >>
546 : overbeek 1.4
547 : overbeek 1.9 =item RETURNS:
548 :    
549 :     Tax-ID of the GenomeO object containing the contig object.
550 : overbeek 1.4
551 :     =back
552 :    
553 :     =cut
554 :    
555 : overbeek 1.1 sub genome {
556 :     my($self) = @_;
557 :    
558 : overbeek 1.10 my $figO = $self->{_figO};
559 :     return new GenomeO($figO,$self->{_genome});
560 : overbeek 1.1 }
561 :    
562 : overbeek 1.4
563 :    
564 :     =head3 contig_length
565 :    
566 : overbeek 1.9 =over 4
567 : overbeek 1.4
568 :     =item USAGE:
569 : overbeek 1.9
570 : overbeek 1.4 C<< my $len = $contig->contig_length(); >>
571 :    
572 : overbeek 1.9 =item RETURNS:
573 :    
574 :     Length of contig's DNA sequence.
575 : overbeek 1.4
576 :     =back
577 :    
578 :     =cut
579 :    
580 : overbeek 1.1 sub contig_length {
581 :     my($self) = @_;
582 :    
583 :     my $fig = $self->{_figO}->{_fig};
584 : overbeek 1.11 my $contig_lengths = $fig->contig_lengths($self->genome->id);
585 : overbeek 1.1 return $contig_lengths->{$self->id};
586 :     }
587 :    
588 : overbeek 1.4
589 :     =head3 dna_seq
590 :    
591 : overbeek 1.9 =over 4
592 : overbeek 1.4
593 :     =item USAGE:
594 : overbeek 1.9
595 : overbeek 1.4 C<< my $seq = $contig->dna_seq(beg, $end); >>
596 :    
597 : overbeek 1.9 =item $beg:
598 :    
599 :     Begining point of DNA subsequence
600 : overbeek 1.4
601 : overbeek 1.9 =item $end:
602 : overbeek 1.4
603 : overbeek 1.9 End point of DNA subsequence
604 : overbeek 1.4
605 : overbeek 1.9 =item RETURNS:
606 :    
607 :     string of DNA sequence running from $beg to $end
608 :     (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
609 : overbeek 1.4
610 :     =back
611 :    
612 :     =cut
613 :    
614 : overbeek 1.1 sub dna_seq {
615 :     my($self,$beg,$end) = @_;
616 :    
617 :     my $fig = $self->{_figO}->{_fig};
618 :     my $max = $self->contig_length;
619 :     if (($beg && (&FIG::between(1,$beg,$max))) &&
620 :     ($end && (&FIG::between(1,$end,$max))))
621 :     {
622 : overbeek 1.11 return $fig->dna_seq($self->genome->id,join("_",($self->id,$beg,$end)));
623 : overbeek 1.1 }
624 :     else
625 :     {
626 :     return undef;
627 :     }
628 :     }
629 :    
630 : overbeek 1.4
631 :     =head3 display
632 :    
633 :     Prints summary information about a "ContigO" object to STDOUT:
634 :    
635 :     Genus, species, strain
636 :    
637 :     Contig ID
638 :    
639 :     Contig length
640 :    
641 : overbeek 1.9 =over 4
642 :    
643 :     =item RETURNS:
644 : overbeek 1.4
645 : overbeek 1.9 (Void)
646 : overbeek 1.4
647 :     =back
648 :    
649 :     =cut
650 :    
651 : overbeek 1.1 sub display {
652 :     my($self) = @_;
653 :    
654 : overbeek 1.11 print join("ContigO",$self->genome->id,$self->id,$self->contig_length),"\n";
655 : overbeek 1.1 }
656 :    
657 : overbeek 1.10 sub features_in_region {
658 :     my($self,$beg,$end) = @_;
659 :     my $figO = $self->{_figO};
660 :     my $fig = $figO->{_fig};
661 : overbeek 1.4
662 : overbeek 1.10 my($features) = $fig->genes_in_region($self->genome->id,$self->id,$beg,$end);
663 :     return map { new FeatureO($figO,$_) } @$features;
664 :     }
665 : overbeek 1.4
666 :     ########################################################################
667 : overbeek 1.1 package FeatureO;
668 : overbeek 1.4 ########################################################################
669 :     use Data::Dumper;
670 :    
671 :     =head1 FeatureO
672 :    
673 : overbeek 1.9 Methods for working with features on "ContigO" objects.
674 :    
675 : overbeek 1.4 =cut
676 :    
677 : overbeek 1.9 =head3 new
678 : overbeek 1.4
679 :     Constructor of "FeatureO" objects
680 :    
681 :     =cut
682 : overbeek 1.1
683 :     sub new {
684 :     my($class,$figO,$fid) = @_;
685 :    
686 :     ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
687 :     my $self = {};
688 :     $self->{_figO} = $figO;
689 :     $self->{_id} = $fid;
690 :     return bless $self, $class;
691 :     }
692 :    
693 : overbeek 1.4
694 :     =head3 id
695 :    
696 :     =cut
697 :    
698 : overbeek 1.1 sub id {
699 :     my($self) = @_;
700 :    
701 :     return $self->{_id};
702 :     }
703 :    
704 : overbeek 1.4
705 :    
706 :     =head3 genome
707 :    
708 :     =cut
709 :    
710 : overbeek 1.1 sub genome {
711 :     my($self) = @_;
712 : overbeek 1.12 my $figO = $self->{_figO};
713 : overbeek 1.1 $self->id =~ /^fig\|(\d+\.\d+)/;
714 : overbeek 1.12 return new GenomeO($figO,$1);
715 : overbeek 1.1 }
716 :    
717 : overbeek 1.4
718 :    
719 :     =head3 type
720 :    
721 :     =cut
722 :    
723 : overbeek 1.1 sub type {
724 :     my($self) = @_;
725 :    
726 :     $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
727 :     return $1;
728 :     }
729 :    
730 : overbeek 1.4
731 :    
732 :    
733 :     =head3 location
734 :    
735 :     =cut
736 :    
737 : overbeek 1.1 sub location {
738 :     my($self) = @_;
739 :    
740 :     my $fig = $self->{_figO}->{_fig};
741 :     return scalar $fig->feature_location($self->id);
742 :     }
743 :    
744 : overbeek 1.12 sub contig {
745 :     my($self) = @_;
746 :    
747 :     my $figO = $self->{_figO};
748 :     my $loc = $self->location;
749 :     my $genomeID = $self->genome->id;
750 :     return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;
751 :     }
752 :    
753 :     sub begin {
754 :     my($self) = @_;
755 :    
756 :     my $loc = $self->location;
757 :     return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
758 :     }
759 : overbeek 1.4
760 : overbeek 1.12 sub end {
761 :     my($self) = @_;
762 :    
763 :     my $loc = $self->location;
764 :     return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
765 :     }
766 : overbeek 1.4
767 :     =head3 dna_seq
768 :    
769 :     =cut
770 :    
771 : overbeek 1.1 sub dna_seq {
772 :     my($self) = @_;
773 :    
774 :     my $fig = $self->{_figO}->{_fig};
775 :     my $fid = $self->id;
776 :     my @loc = $fig->feature_location($fid);
777 :     return $fig->dna_seq(&FIG::genome_of($fid),@loc);
778 :     }
779 :    
780 : overbeek 1.4
781 :    
782 :     =head3 prot_seq
783 :    
784 :     =cut
785 :    
786 : overbeek 1.1 sub prot_seq {
787 :     my($self) = @_;
788 :    
789 :     ($self->type eq "peg") || return undef;
790 :     my $fig = $self->{_figO}->{_fig};
791 :     my $fid = $self->id;
792 :     return $fig->get_translation($fid);
793 :     }
794 :    
795 : overbeek 1.4
796 :    
797 :     =head3 function_of
798 :    
799 :     =cut
800 :    
801 : overbeek 1.1 sub function_of {
802 :     my($self) = @_;
803 :    
804 :     my $fig = $self->{_figO}->{_fig};
805 :     my $fid = $self->id;
806 :     return scalar $fig->function_of($fid);
807 :     }
808 :    
809 : overbeek 1.4
810 :    
811 :     =head3 coupled_to
812 :    
813 :     =cut
814 :    
815 : overbeek 1.1 sub coupled_to {
816 :     my($self) = @_;
817 :    
818 :     ($self->type eq "peg") || return undef;
819 :     my $figO = $self->{_figO};
820 :     my $fig = $figO->{_fig};
821 :     my $peg1 = $self->id;
822 :     my @coupled = ();
823 :     foreach my $tuple ($fig->coupled_to($peg1))
824 :     {
825 :     my($peg2,$sc) = @$tuple;
826 :     push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));
827 :     }
828 :     return @coupled;
829 :     }
830 :    
831 : overbeek 1.4
832 :    
833 :     =head3 annotations
834 :    
835 :     =cut
836 :    
837 : overbeek 1.1 sub annotations {
838 :     my($self) = @_;
839 :    
840 :     my $figO = $self->{_figO};
841 :     my $fig = $figO->{_fig};
842 :    
843 :     return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
844 :     }
845 :    
846 : overbeek 1.5 sub in_subsystems {
847 :     my($self) = @_;
848 :     my $figO = $self->{_figO};
849 :     my $fig = $figO->{_fig};
850 :    
851 :     return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);
852 :     }
853 : overbeek 1.4
854 :    
855 :     =head3 possibly_truncated
856 :    
857 :     =cut
858 :    
859 : overbeek 1.3 sub possibly_truncated {
860 :     my($self) = @_;
861 :     my $figO = $self->{_figO};
862 :     my $fig = $figO->{_fig};
863 :    
864 :     return $fig->possibly_truncated($self->id);
865 :     }
866 :    
867 : overbeek 1.4
868 :    
869 :     =head3 possible_frameshift
870 :    
871 :     =cut
872 :    
873 : overbeek 1.3 sub possible_frameshift {
874 :     my($self) = @_;
875 :     my $figO = $self->{_figO};
876 :     my($tmp_dir) = $figO->{_tmp_dir};
877 :    
878 :     if (! $self->possibly_truncated)
879 :     {
880 :     my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);
881 :     if (my $sim = shift @sims)
882 :     {
883 :     my $peg2 = $sim->id2;
884 :     my $ln1 = $sim->ln1;
885 :     my $ln2 = $sim->ln2;
886 :     my $b2 = $sim->b2;
887 :     my $e2 = $sim->e2;
888 :     my $adjL = 100 + (($b2-1) * 3);
889 :     my $adjR = 100 + (($ln2 - $e2) * 3);
890 :     if ($ln2 > (1.2 * $ln1))
891 :     {
892 :     my $loc = $self->location;
893 :     if ($loc =~ /^(\S+)_(\d+)_(\d+)/)
894 :     {
895 :     my $contig = $1;
896 :     my $beg = $2;
897 :     my $end = $3;
898 : overbeek 1.11 my $contigO = new ContigO($figO,$self->genome->id,$contig);
899 : overbeek 1.3 my $begA = &max(1,$beg - $adjL);
900 :     my $endA = &min($end+$adjR,$contigO->contig_length);
901 :     my $dna = $contigO->dna_seq($begA,$endA);
902 :     open(TMP,">$tmp_dir/tmp_dna") || die "couild not open tmp_dna";
903 :     print TMP ">dna\n$dna\n";
904 :     close(TMP);
905 :    
906 :     my $peg2O = new FeatureO($figO,$peg2);
907 :     my $prot = $peg2O->prot_seq;
908 :     open(TMP,">$tmp_dir/tmp_prot") || die "could not open tmp_prot";
909 :     print TMP ">tmp_prot\n$prot\n";
910 :     close(TMP);
911 :     &run("formatdb -i $tmp_dir/tmp_dna -pF");
912 :     open(BLAST,"blastall -i $tmp_dir/tmp_prot -d $tmp_dir/tmp_dna -p tblastn -FF -e 1.0e-50 |")
913 :     || die "could not blast";
914 :    
915 :     my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);
916 :     my @hsps = sort { $a->[0] <=> $b->[0] }
917 :     map { [$_->[9],$_->[10],$_->[12],$_->[13]] }
918 :     grep { $_->[1] < 1.0e-50 }
919 :     @{$db_seq_out->[6]};
920 :     my @prot = map { [$_->[0],$_->[1]] } @hsps;
921 :     my @dna = map { [$_->[2],$_->[3]] } @hsps;
922 :     if (&covers(\@prot,length($prot),3) && &covers(\@dna,3*length($prot),9))
923 :     {
924 :     return 1;
925 :     }
926 :     }
927 :     }
928 :     }
929 :     }
930 :     return 0;
931 :     }
932 :    
933 : overbeek 1.4
934 :    
935 :     =head3 run
936 :    
937 : overbeek 1.9 =sub
938 : overbeek 1.4
939 : overbeek 1.9 cut run {
940 : overbeek 1.3 my($cmd) = @_;
941 :     (system($cmd) == 0) || Confess("FAILED: $cmd");
942 :     }
943 :    
944 : overbeek 1.4
945 :    
946 :     =head3 max
947 :    
948 :     =cut
949 :    
950 : overbeek 1.3 sub max {
951 :     my($x,$y) = @_;
952 :     return ($x < $y) ? $y : $x;
953 :     }
954 :    
955 : overbeek 1.4
956 :    
957 :     =head3 min
958 :    
959 :     =cut
960 :    
961 : overbeek 1.3 sub min {
962 :     my($x,$y) = @_;
963 :     return ($x < $y) ? $x : $y;
964 :     }
965 :    
966 : overbeek 1.4
967 :    
968 :     =head3 covers
969 :    
970 :     =cut
971 :    
972 : overbeek 1.3 sub covers {
973 :     my($hsps,$ln,$diff) = @_;
974 :    
975 :     my $hsp1 = shift @$hsps;
976 :     my $hsp2;
977 :     while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}
978 :     return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
979 :     }
980 :    
981 : overbeek 1.4
982 :    
983 :     =head3 merge
984 :    
985 :     =cut
986 :    
987 : overbeek 1.3 sub merge {
988 :     my($hsp1,$hsp2,$diff) = @_;
989 :    
990 :     my($b1,$e1) = @$hsp1;
991 :     my($b2,$e2) = @$hsp2;
992 :     return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;
993 :     }
994 :    
995 : overbeek 1.4
996 :    
997 :     =head3 sims
998 :    
999 :     =cut
1000 :    
1001 : overbeek 1.2 use Sim;
1002 :     sub sims {
1003 :     my($self,%args) = @_;
1004 :    
1005 :     my $figO = $self->{_figO};
1006 :     my $fig = $figO->{_fig};
1007 :    
1008 :     my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
1009 :     my $all = $args{-all} ? $args{-all} : "fig";
1010 :     my $max = $args{-max} ? $args{-max} : 10000;
1011 :    
1012 :     return $fig->sims($self->id,$max,$cutoff,$all);
1013 :     }
1014 :    
1015 : overbeek 1.4
1016 :    
1017 :     =head3 bbhs
1018 :    
1019 :     =cut
1020 :    
1021 : overbeek 1.2 sub bbhs {
1022 :     my($self) = @_;
1023 :    
1024 :     my $figO = $self->{_figO};
1025 :     my $fig = $figO->{_fig};
1026 :    
1027 :     my @bbhs = $fig->bbhs($self->id);
1028 : overbeek 1.6 return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
1029 :     _peg1 => $self->id,
1030 : overbeek 1.2 _peg2 => $peg2,
1031 :     _psc => $sc,
1032 :     _bit_score => $bs
1033 :     },'BBHO') } @bbhs;
1034 :     }
1035 :    
1036 : overbeek 1.4 =head3 display
1037 :    
1038 :     =cut
1039 :    
1040 : overbeek 1.1 sub display {
1041 :     my($self) = @_;
1042 :    
1043 :     print join("\t",$self->id,$self->location,$self->function_of),"\n",
1044 :     $self->dna_seq,"\n",
1045 :     $self->prot_seq,"\n";
1046 :     }
1047 :    
1048 : overbeek 1.4
1049 :    
1050 :     ########################################################################
1051 : overbeek 1.2 package BBHO;
1052 : overbeek 1.4 ########################################################################
1053 :    
1054 :     =head1 BBHO
1055 :    
1056 :     =cut
1057 :    
1058 :    
1059 :     =head3 new
1060 :    
1061 :     =cut
1062 : overbeek 1.2
1063 :     sub new {
1064 : overbeek 1.6 my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
1065 : overbeek 1.2
1066 :     my $self = {};
1067 : overbeek 1.6 $self->{_figO} = $figO;
1068 : overbeek 1.2 $self->{_peg1} = $peg1;
1069 :     $self->{_peg2} = $peg2;
1070 :     $self->{_psc} = $sc;
1071 :     $self->{_bit_score} = $normalized_bitscore
1072 :    
1073 :     }
1074 :    
1075 : overbeek 1.4
1076 :     =head3 peg1
1077 :    
1078 :     =cut
1079 :    
1080 : overbeek 1.2 sub peg1 {
1081 :     my($self) = @_;
1082 :    
1083 : overbeek 1.6 my $figO = $self->{_figO};
1084 :     return new FeatureO($figO,$self->{_peg1});
1085 : overbeek 1.2 }
1086 :    
1087 : overbeek 1.6 =head3 peg2
1088 : overbeek 1.4
1089 :     =cut
1090 :    
1091 : overbeek 1.2 sub peg2 {
1092 :     my($self) = @_;
1093 :    
1094 : overbeek 1.6 my $figO = $self->{_figO};
1095 :     return new FeatureO($figO,$self->{_peg2});
1096 : overbeek 1.2 }
1097 :    
1098 : overbeek 1.4
1099 :    
1100 :     =head3 psc
1101 :    
1102 :     =cut
1103 :    
1104 : overbeek 1.2 sub psc {
1105 :     my($self) = @_;
1106 :    
1107 :     return $self->{_psc};
1108 :     }
1109 :    
1110 : overbeek 1.4
1111 :    
1112 :     =head3 norm_bitscore
1113 :    
1114 :     =cut
1115 :    
1116 : overbeek 1.2 sub norm_bitscore {
1117 :     my($self) = @_;
1118 :    
1119 :     return $self->{_bit_score};
1120 :     }
1121 :    
1122 : overbeek 1.4
1123 :    
1124 :     ########################################################################
1125 : overbeek 1.1 package AnnotationO;
1126 : overbeek 1.4 ########################################################################
1127 :    
1128 :     =head1 AnnotationO
1129 :    
1130 :     =cut
1131 :    
1132 :    
1133 :    
1134 :     =head3 new
1135 :    
1136 :     =cut
1137 : overbeek 1.1
1138 :     sub new {
1139 :     my($class,$fid,$timestamp,$who,$text) = @_;
1140 :    
1141 :     my $self = {};
1142 :     $self->{_fid} = $fid;
1143 :     $self->{_timestamp} = $timestamp;
1144 :     $self->{_who} = $who;
1145 :     $self->{_text} = $text;
1146 :     return bless $self, $class;
1147 :     }
1148 :    
1149 : overbeek 1.4
1150 :    
1151 :     =head3 fid
1152 :    
1153 :     =cut
1154 :    
1155 : overbeek 1.1 sub fid {
1156 :     my($self) = @_;
1157 :    
1158 :     return $self->{_fid};
1159 :     }
1160 :    
1161 : overbeek 1.4
1162 :    
1163 :     =head3 timestamp
1164 :    
1165 :     =cut
1166 :    
1167 : overbeek 1.1 sub timestamp {
1168 :     my($self,$convert) = @_;
1169 :    
1170 :     if ($convert)
1171 :     {
1172 :     return scalar localtime($self->{_timestamp});
1173 :     }
1174 :     else
1175 :     {
1176 :     return $self->{_timestamp};
1177 :     }
1178 :     }
1179 :    
1180 : overbeek 1.4
1181 :    
1182 :     =head3 made_by
1183 :    
1184 :     =cut
1185 :    
1186 : overbeek 1.1 sub made_by {
1187 :     my($self) = @_;
1188 :    
1189 :     my $who = $self->{_who};
1190 :     $who =~ s/^master://i;
1191 :     return $who;
1192 :     }
1193 :    
1194 : overbeek 1.4
1195 :    
1196 :     =head3 text
1197 :    
1198 :     =cut
1199 :    
1200 : overbeek 1.1 sub text {
1201 :     my($self) = @_;
1202 :    
1203 :     my $text = $self->{_text};
1204 :     return $text;
1205 :     }
1206 :    
1207 : overbeek 1.4
1208 :     =head3 display
1209 :    
1210 :     =cut
1211 :    
1212 : overbeek 1.1 sub display {
1213 :     my($self) = @_;
1214 :    
1215 :     print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1216 :     }
1217 :    
1218 : overbeek 1.4
1219 :    
1220 :     ########################################################################
1221 : overbeek 1.1 package CouplingO;
1222 : overbeek 1.4 ########################################################################
1223 :     use Data::Dumper;
1224 :    
1225 :     =head3 new
1226 : overbeek 1.1
1227 : overbeek 1.4 =cut
1228 : overbeek 1.1
1229 :     sub new {
1230 :     my($class,$figO,$peg1,$peg2,$sc) = @_;
1231 :    
1232 :     ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1233 :     ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1234 :     my $self = {};
1235 :     $self->{_figO} = $figO;
1236 :     $self->{_peg1} = $peg1;
1237 :     $self->{_peg2} = $peg2;
1238 :     $self->{_sc} = $sc;
1239 :     return bless $self, $class;
1240 :     }
1241 :    
1242 : overbeek 1.4
1243 :    
1244 :     =head3 peg1
1245 :    
1246 :     =cut
1247 :    
1248 : overbeek 1.1 sub peg1 {
1249 :     my($self) = @_;
1250 :    
1251 : overbeek 1.5 my $figO = $self->{_figO};
1252 :     return new FeatureO($figO,$self->{_peg1});
1253 : overbeek 1.1 }
1254 :    
1255 : overbeek 1.4
1256 :    
1257 :     =head3 peg1
1258 :    
1259 :     =cut
1260 :    
1261 : overbeek 1.1 sub peg2 {
1262 :     my($self) = @_;
1263 :    
1264 : overbeek 1.5 my $figO = $self->{_figO};
1265 :     return new FeatureO($figO,$self->{_peg2});
1266 : overbeek 1.1 }
1267 :    
1268 : overbeek 1.4
1269 :    
1270 :     =head3 sc
1271 :    
1272 :     =cut
1273 :    
1274 : overbeek 1.1 sub sc {
1275 :     my($self) = @_;
1276 :    
1277 :     return $self->{_sc};
1278 :     }
1279 :    
1280 : overbeek 1.4
1281 :    
1282 :     =head3 evidence
1283 :    
1284 :     =cut
1285 :    
1286 : overbeek 1.1 sub evidence {
1287 :     my($self) = @_;
1288 :    
1289 :     my $figO = $self->{_figO};
1290 :     my $fig = $figO->{_fig};
1291 :     my @ev = ();
1292 :     foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))
1293 :     {
1294 :     my($peg3,$peg4,$rep) = @$tuple;
1295 :     push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
1296 :     &FeatureO::new('FeatureO',$figO,$peg4),
1297 :     $rep]);
1298 :     }
1299 :     return @ev;
1300 :     }
1301 :    
1302 : overbeek 1.4
1303 :    
1304 :     =head3 display
1305 :    
1306 :     =cut
1307 :    
1308 : overbeek 1.1 sub display {
1309 :     my($self) = @_;
1310 :    
1311 :     print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1312 :     }
1313 :    
1314 : overbeek 1.4
1315 :    
1316 :     ########################################################################
1317 : overbeek 1.1 package SubsystemO;
1318 : overbeek 1.4 ########################################################################
1319 : overbeek 1.1 use Data::Dumper;
1320 :     use Subsystem;
1321 :    
1322 : overbeek 1.4 =head1 SubsystemO
1323 :    
1324 :     =cut
1325 :    
1326 :    
1327 :    
1328 :     =head3 new
1329 :    
1330 :     =cut
1331 :    
1332 : overbeek 1.1 sub new {
1333 :     my($class,$figO,$name) = @_;
1334 :    
1335 :     my $self = {};
1336 :     $self->{_figO} = $figO;
1337 :     $self->{_id} = $name;
1338 :    
1339 :     return bless $self, $class;
1340 :     }
1341 :    
1342 : overbeek 1.4
1343 :    
1344 :     =head3 id
1345 :    
1346 :     =cut
1347 :    
1348 : overbeek 1.1 sub id {
1349 :     my($self) = @_;
1350 :    
1351 :     return $self->{_id};
1352 :     }
1353 :    
1354 : overbeek 1.4
1355 :    
1356 :     =head3 usable
1357 :    
1358 :     =cut
1359 :    
1360 : overbeek 1.1 sub usable {
1361 :     my($self) = @_;
1362 :    
1363 :     my $figO = $self->{_figO};
1364 :     my $fig = $figO->{_fig};
1365 :     return $fig->usable_subsystem($self->id);
1366 :     }
1367 :    
1368 : overbeek 1.4
1369 :    
1370 :     =head3 genomes
1371 :    
1372 :     =cut
1373 :    
1374 : overbeek 1.1 sub genomes {
1375 :     my($self) = @_;
1376 :    
1377 :     my $figO = $self->{_figO};
1378 :     my $subO = $self->{_subO};
1379 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1380 :    
1381 :     return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1382 :     }
1383 :    
1384 : overbeek 1.9
1385 :    
1386 : overbeek 1.4 =head3 roles
1387 :    
1388 :     =cut
1389 :    
1390 : overbeek 1.1 sub roles {
1391 :     my($self) = @_;
1392 :    
1393 :     my $figO = $self->{_figO};
1394 :     my $subO = $self->{_subO};
1395 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1396 : overbeek 1.9
1397 : overbeek 1.1 return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) } $subO->get_roles($self->id);
1398 :     }
1399 :    
1400 : overbeek 1.9
1401 :    
1402 : overbeek 1.4 =head3 curator
1403 :    
1404 :     =cut
1405 :    
1406 : overbeek 1.1 sub curator {
1407 :     my($self) = @_;
1408 :    
1409 :     my $figO = $self->{_figO};
1410 :     my $subO = $self->{_subO};
1411 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1412 : overbeek 1.9
1413 :     return $subO->get_curator;
1414 : overbeek 1.1 }
1415 :    
1416 : overbeek 1.4
1417 :    
1418 :    
1419 :     =head3 variant
1420 :    
1421 :     =cut
1422 :    
1423 : overbeek 1.1 sub variant {
1424 :     my($self,$genome) = @_;
1425 :    
1426 :     my $figO = $self->{_figO};
1427 :     my $subO = $self->{_subO};
1428 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1429 :    
1430 :     return $subO->get_variant_code_for_genome($genome->id);
1431 :     }
1432 : overbeek 1.4
1433 :    
1434 :    
1435 :     =head3 pegs_in_cell
1436 :    
1437 :     =cut
1438 :    
1439 : overbeek 1.1 sub pegs_in_cell {
1440 :     my($self,$genome,$role) = @_;
1441 :    
1442 :     my $figO = $self->{_figO};
1443 :     my $subO = $self->{_subO};
1444 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1445 :    
1446 :     return $subO->get_pegs_from_cell($genome->id,$role->id);
1447 :     }
1448 :    
1449 : overbeek 1.4
1450 :    
1451 :     ########################################################################
1452 : overbeek 1.1 package FunctionalRoleO;
1453 : overbeek 1.4 ########################################################################
1454 :     use Data::Dumper;
1455 : overbeek 1.1
1456 : overbeek 1.4 =head1 FunctionalRoleO
1457 :    
1458 : overbeek 1.9 Methods for accessing the functional roles of features.
1459 :    
1460 : overbeek 1.4 =cut
1461 :    
1462 :    
1463 :     =head3 new
1464 :    
1465 :     =cut
1466 : overbeek 1.1
1467 :     sub new {
1468 :     my($class,$figO,$fr) = @_;
1469 :    
1470 :     my $self = {};
1471 :     $self->{_figO} = $figO;
1472 :     $self->{_id} = $fr;
1473 :     return bless $self, $class;
1474 :     }
1475 :    
1476 : overbeek 1.4
1477 :    
1478 :     =head3 id
1479 :    
1480 :     =cut
1481 :    
1482 : overbeek 1.1 sub id {
1483 :     my($self) = @_;
1484 :    
1485 :     return $self->{_id};
1486 :     }
1487 :    
1488 : overbeek 1.4
1489 :    
1490 :     ########################################################################
1491 : overbeek 1.1 package FigFamO;
1492 : overbeek 1.4 ########################################################################
1493 : overbeek 1.1 use FigFams;
1494 :     use FigFam;
1495 :    
1496 : overbeek 1.4
1497 :     =head1 FigFamO
1498 :    
1499 :     =cut
1500 :    
1501 :    
1502 :     =head3 new
1503 :    
1504 :     =cut
1505 :    
1506 : overbeek 1.1 sub new {
1507 :     my($class,$figO,$id) = @_;
1508 :    
1509 :     my $self = {};
1510 :     $self->{_figO} = $figO;
1511 :     $self->{_id} = $id;
1512 :     return bless $self, $class;
1513 :     }
1514 :    
1515 : overbeek 1.4
1516 :    
1517 :     =head3 id
1518 :    
1519 :     =cut
1520 :    
1521 : overbeek 1.1 sub id {
1522 :     my($self) = @_;
1523 :    
1524 :     return $self->{_id};
1525 :     }
1526 :    
1527 : overbeek 1.4
1528 :     =head3 function
1529 :    
1530 :     =cut
1531 :    
1532 : overbeek 1.1 sub function {
1533 :     my($self) = @_;
1534 :    
1535 :     my $fig = $self->{_figO}->{_fig};
1536 :     my $famO = $self->{_famO};
1537 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1538 :    
1539 :     return $famO->family_function;
1540 :     }
1541 :    
1542 : overbeek 1.4
1543 :    
1544 :     =head3 members
1545 :    
1546 :     =cut
1547 :    
1548 : overbeek 1.1 sub members {
1549 :     my($self) = @_;
1550 :    
1551 :     my $figO = $self->{_figO};
1552 :     my $fig = $figO->{_fig};
1553 :     my $famO = $self->{_famO};
1554 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1555 :    
1556 :     return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;
1557 :     }
1558 :    
1559 : overbeek 1.4
1560 :    
1561 :     =head3 rep_seqs
1562 :    
1563 :     =cut
1564 :    
1565 : overbeek 1.1 sub rep_seqs {
1566 :     my($self) = @_;
1567 :    
1568 :     my $figO = $self->{_figO};
1569 :     my $fig = $figO->{_fig};
1570 :     my $famO = $self->{_famO};
1571 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1572 :    
1573 :     return $famO->representatives;
1574 :     }
1575 :    
1576 : overbeek 1.4
1577 :    
1578 :     =head3 should_be_member
1579 :    
1580 :     =cut
1581 :    
1582 : overbeek 1.1 sub should_be_member {
1583 :     my($self,$seq) = @_;
1584 :    
1585 :     my $figO = $self->{_figO};
1586 :     my $fig = $figO->{_fig};
1587 :     my $famO = $self->{_famO};
1588 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1589 :    
1590 :     return $famO->should_be_member($seq);
1591 :     }
1592 :    
1593 :    
1594 :    
1595 : overbeek 1.4 =head3 display
1596 :    
1597 :     =cut
1598 :    
1599 : overbeek 1.1 sub display {
1600 :     my($self) = @_;
1601 :    
1602 :     print join("\t",($self->id,$self->function)),"\n";
1603 :     }
1604 :    
1605 :    
1606 :    
1607 : overbeek 1.4 ########################################################################
1608 : overbeek 1.1 package Attribute;
1609 : overbeek 1.4 ########################################################################
1610 :     =head1 Attribute
1611 :    
1612 : overbeek 1.9 (Note yet implemented.)
1613 :    
1614 : overbeek 1.4 =cut
1615 : overbeek 1.1
1616 :     1;
1617 : overbeek 1.4 __END__
1618 :    
1619 :     =head1 Examples
1620 :    
1621 :     =head3 Display all complete, prokaryotic genomes
1622 :    
1623 :     use FIGO;
1624 :     my $figO = new FIGO;
1625 :    
1626 :     foreach $genome ($figO->genomes('complete','prokaryotic'))
1627 :     {
1628 :     $genome->display;
1629 :     }
1630 :    
1631 :     #---------------------------------------------
1632 :    
1633 :     use FIG;
1634 :     my $fig = new FIG;
1635 :    
1636 :     foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
1637 :     {
1638 :     print join("\t",("Genome",$genome,$fig->genus_species($genome))),"\n";
1639 :     }
1640 :    
1641 :     ###############################################
1642 :    
1643 :     =head3 Show how to access contigs and extract sequence
1644 :    
1645 :     use FIGO;
1646 :     my $figO = new FIGO;
1647 :    
1648 :     $genomeId = '83333.1';
1649 :     my $genome = new GenomeO($figO,$genomeId);
1650 :    
1651 :     foreach $contig ($genome->contigs_of)
1652 :     {
1653 :     $tag1 = $contig->dna_seq(1,10);
1654 :     $tag2 = $contig->dna_seq(10,1);
1655 :     print join("\t",($tag1,$tag2,$contig->id,$contig->contig_length)),"\n";
1656 :     }
1657 :    
1658 :     #---------------------------------------------
1659 :    
1660 :     use FIG;
1661 :     my $fig = new FIG;
1662 :    
1663 :     $genomeId = '83333.1';
1664 :    
1665 :     $contig_lengths = $fig->contig_lengths($genomeId);
1666 :    
1667 :     foreach $contig ($fig->contigs_of($genomeId))
1668 :     {
1669 :     $tag1 = $fig->dna_seq($genomeId,join("_",($contig,1,10)));
1670 :     $tag2 = $fig->dna_seq($genomeId,join("_",($contig,10,1)));
1671 :     print join("\t",($tag1,$tag2,$contig,$contig_lengths->{$contig})),"\n";
1672 :     }
1673 :    
1674 :     ###############################################
1675 :    
1676 :     ### accessing data related to features
1677 :    
1678 :     use FIGO;
1679 :     my $figO = new FIGO;
1680 :    
1681 :     my $genome = new GenomeO($figO,"83333.1");
1682 :     my $peg = "fig|83333.1.peg.4";
1683 :     my $pegO = new FeatureO($figO,$peg);
1684 :    
1685 :     print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
1686 :     $pegO->dna_seq,"\n",
1687 :     $pegO->prot_seq,"\n";
1688 :    
1689 :     foreach $fidO ($genome->features_of('rna'))
1690 :     {
1691 :     print join("\t",$fidO->id,$fidO->location,$fidO->function_of),"\n";
1692 :     }
1693 :    
1694 :     #---------------------------------------------
1695 :    
1696 :    
1697 :     use FIG;
1698 :     my $fig = new FIG;
1699 :    
1700 :     my $genome = "83333.1";
1701 :     my $peg = "fig|83333.1.peg.4";
1702 :    
1703 :     print join("\t",$peg,scalar $fig->feature_location($peg),scalar $fig->function_of($peg)),"\n",
1704 :     $fig->dna_seq($genome,$fig->feature_location($peg)),"\n",
1705 :     $fig->get_translation($peg),"\n";
1706 :    
1707 :     foreach $fid ($fig->all_features($genome,'rna'))
1708 :     {
1709 :     print join("\t",$fid,scalar $fig->feature_location($fid),scalar $fig->function_of($fid)),"\n";
1710 :     }
1711 :    
1712 :     ###############################################
1713 :    
1714 :     ### accessing similarities
1715 :    
1716 :     use FIGO;
1717 :     my $figO = new FIGO;
1718 :    
1719 :     $peg = "fig|83333.1.peg.4";
1720 :     $pegO = new FeatureO($figO,$peg);
1721 :    
1722 :     @sims = $pegO->sims; # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
1723 :     # sims (including non-FIG sequences
1724 :     foreach $sim (@sims)
1725 :     {
1726 :     $peg2 = $sim->id2;
1727 :     $pegO2 = new FeatureO($figO,$peg2);
1728 :     $func = $pegO2->function_of;
1729 :     $sc = $sim->psc;
1730 :     print join("\t",($peg2,$sc,$func)),"\n";
1731 :     }
1732 :    
1733 :     #---------------------------------------------
1734 :    
1735 :    
1736 :     use FIG;
1737 :     my $fig = new FIG;
1738 :    
1739 :     $peg = "fig|83333.1.peg.4";
1740 :    
1741 :     @sims = $fig->sims($peg,1000,1.0e-5,"fig");
1742 :     foreach $sim (@sims)
1743 :     {
1744 :     $peg2 = $sim->id2;
1745 :     $func = $fig->function_of($peg2);
1746 :     $sc = $sim->psc;
1747 :     print join("\t",($peg2,$sc,$func)),"\n";
1748 :     }
1749 :    
1750 :     ###############################################
1751 :    
1752 :     ### accessing BBHs
1753 :    
1754 :     use FIGO;
1755 :     my $figO = new FIGO;
1756 :    
1757 :     $peg = "fig|83333.1.peg.4";
1758 :     $pegO = new FeatureO($figO,$peg);
1759 :    
1760 :     @bbhs = $pegO->bbhs;
1761 :     foreach $bbh (@bbhs)
1762 :     {
1763 :     $peg2 = $bbh->peg2;
1764 :     $pegO2 = new FeatureO($figO,$peg2);
1765 :     $func = $pegO2->function_of;
1766 :     $sc = $bbh->psc;
1767 :     print join("\t",($peg2,$sc,$func)),"\n";
1768 :     }
1769 :    
1770 :     #---------------------------------------------
1771 :    
1772 :     use FIG;
1773 :     my $fig = new FIG;
1774 :    
1775 :     $peg = "fig|83333.1.peg.4";
1776 :    
1777 :     @bbhs = $fig->bbhs($peg);
1778 :     foreach $bbh (@bbhs)
1779 :     {
1780 :     ($peg2,$sc,$bit_score) = @$bbh;
1781 :     $func = $fig->function_of($peg2);
1782 :     print join("\t",($peg2,$sc,$func)),"\n";
1783 :     }
1784 :    
1785 :     ###############################################
1786 :    
1787 :     ### accessing annotations
1788 :    
1789 :     use FIGO;
1790 :     my $figO = new FIGO;
1791 :    
1792 :     $peg = "fig|83333.1.peg.4";
1793 :     $pegO = new FeatureO($figO,$peg);
1794 :    
1795 :     @annotations = $pegO->annotations;
1796 :    
1797 :     foreach $ann (@annotations)
1798 :     {
1799 :     print join("\n",$ann->fid,$ann->timestamp(1),$ann->made_by,$ann->text),"\n\n";
1800 :     }
1801 :    
1802 :     #---------------------------------------------
1803 :    
1804 :     use FIG;
1805 :     my $fig = new FIG;
1806 :    
1807 :     $peg = "fig|83333.1.peg.4";
1808 :     @annotations = $fig->feature_annotations($peg);
1809 :     foreach $_ (@annotations)
1810 :     {
1811 :     (undef,$ts,$who,$text) = @$_;
1812 :     $who =~ s/master://i;
1813 :     print "$ts\n$who\n$text\n\n";
1814 :     }
1815 :    
1816 :     ###############################################
1817 :    
1818 :     ### accessing coupling data
1819 :    
1820 :    
1821 :     use FIGO;
1822 :     my $figO = new FIGO;
1823 :    
1824 :     my $peg = "fig|83333.1.peg.4";
1825 :     my $pegO = new FeatureO($figO,$peg);
1826 :     foreach $coupled ($pegO->coupled_to)
1827 :     {
1828 :     print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
1829 :     foreach $tuple ($coupled->evidence)
1830 :     {
1831 :     my($peg3O,$peg4O,$rep) = @$tuple;
1832 :     print "\t",join("\t",($peg3O->id,$peg4O->id,$rep)),"\n";
1833 :     }
1834 :     print "\n";
1835 :     }
1836 :    
1837 :     #---------------------------------------------
1838 :    
1839 :    
1840 :     use FIG;
1841 :     my $fig = new FIG;
1842 :    
1843 :     my $peg1 = "fig|83333.1.peg.4";
1844 :     foreach $coupled ($fig->coupled_to($peg1))
1845 :     {
1846 :     ($peg2,$sc) = @$coupled;
1847 :     print join("\t",($peg1,$peg2,$sc)),"\n";
1848 :     foreach $tuple ($fig->coupling_evidence($peg1,$peg2))
1849 :     {
1850 :     my($peg3,$peg4,$rep) = @$tuple;
1851 :     print "\t",join("\t",($peg3,$peg4,$rep)),"\n";
1852 :     }
1853 :     print "\n";
1854 :     }
1855 :    
1856 :     ###############################################
1857 :    
1858 :     =head3 Accessing Subsystem data
1859 :    
1860 :     use FIGO;
1861 :     my $figO = new FIGO;
1862 :    
1863 :     foreach $sub ($figO->subsystems)
1864 :     {
1865 :     if ($sub->usable)
1866 :     {
1867 :     print join("\t",($sub->id,$sub->curator)),"\n";
1868 :    
1869 :     print "\tRoles\n";
1870 :     @roles = $sub->roles;
1871 :     foreach $role (@roles)
1872 :     {
1873 :     print "\t\t",join("\t",($role->id)),"\n";
1874 :     }
1875 :    
1876 :     print "\tGenomes\n";
1877 :     foreach $genome ($sub->genomes)
1878 :     {
1879 :     print "\t\t",join("\t",($sub->variant($genome),
1880 :     $genome->id,
1881 :     $genome->genus_species)),"\n";
1882 :     @pegs = ();
1883 :     foreach $role (@roles)
1884 :     {
1885 :     push(@pegs,$sub->pegs_in_cell($genome,$role));
1886 :     }
1887 :     print "\t\t\t",join(",",@pegs),"\n";
1888 :     }
1889 :     }
1890 :     }
1891 :    
1892 :     #---------------------------------------------
1893 :    
1894 :     use FIG;
1895 :     my $fig = new FIG;
1896 :    
1897 :     foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
1898 :     {
1899 :     $subO = new Subsystem($sub,$fig);
1900 :     $curator = $subO->get_curator;
1901 :     print join("\t",($sub,$curator)),"\n";
1902 :    
1903 :     print "\tRoles\n";
1904 :     @roles = $subO->get_roles;
1905 :     foreach $role (@roles)
1906 :     {
1907 :     print "\t\t",join("\t",($role)),"\n";
1908 :     }
1909 :    
1910 :     print "\tGenomes\n";
1911 :     foreach $genome ($subO->get_genomes)
1912 :     {
1913 :     print "\t\t",join("\t",($subO->get_variant_code_for_genome($genome),
1914 :     $genome,
1915 :     $fig->genus_species($genome))),"\n";
1916 :     foreach $role (@roles)
1917 :     {
1918 :     push(@pegs,$subO->get_pegs_from_cell($genome,$role));
1919 :     }
1920 :     print "\t\t\t",join(",",@pegs),"\n";
1921 :     }
1922 :     print "\n";
1923 :     }
1924 :    
1925 :     ###############################################
1926 :    
1927 :     =head3 Accessing FIGfams
1928 :    
1929 :     use FIGO;
1930 :     my $figO = new FIGO;
1931 :    
1932 :     foreach $fam ($figO->all_figfams)
1933 :     {
1934 :     print join("\t",($fam->id,$fam->function)),"\n";
1935 :     foreach $pegO ($fam->members)
1936 :     {
1937 :     $peg = $pegO->id;
1938 :     print "\t$peg\n";
1939 :     }
1940 :     }
1941 :    
1942 :     #---------------------------------------------
1943 :    
1944 :     use FIG;
1945 :     use FigFam;
1946 :     use FigFams;
1947 :    
1948 :     my $fig = new FIG;
1949 :     my $figfams = new FigFams($fig);
1950 :    
1951 :     foreach $fam ($figfams->all_families)
1952 :     {
1953 :     my $figfam = new FigFam($fig,$fam);
1954 :     print join("\t",($fam,$figfam->family_function)),"\n";
1955 :     foreach $peg ($figfam->list_members)
1956 :     {
1957 :     print "\t$peg\n";
1958 :     }
1959 :     }
1960 :    
1961 :     ###############################################
1962 :    
1963 :     =head3 Placing a sequence into a FIGfam
1964 :    
1965 :     use FIGO;
1966 :     my $figO = new FIGO;
1967 :    
1968 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1969 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1970 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1971 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1972 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1973 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1974 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1975 :     RKLMMNHQ";
1976 :     $seq =~ s/\n//gs;
1977 :    
1978 :     my($fam,$sims) = $figO->family_containing($seq);
1979 :    
1980 :     if ($fam)
1981 :     {
1982 :     print join("\t",($fam->id,$fam->function)),"\n";
1983 :     print &Dumper($sims);
1984 :     }
1985 :     else
1986 :     {
1987 :     print "Could not place it in a family\n";
1988 :     }
1989 :    
1990 :     #---------------------------------------------
1991 :    
1992 :     use FIG;
1993 :     use FigFam;
1994 :     use FigFams;
1995 :    
1996 :     my $fig = new FIG;
1997 :     my $figfams = new FigFams($fig);
1998 :    
1999 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2000 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2001 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2002 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2003 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2004 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2005 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2006 :     RKLMMNHQ";
2007 :     $seq =~ s/\n//gs;
2008 :    
2009 :     my($fam,$sims) = $figfams->place_in_family($seq);
2010 :    
2011 :     if ($fam)
2012 :     {
2013 :     print join("\t",($fam->family_id,$fam->family_function)),"\n";
2014 :     print &Dumper($sims);
2015 :     }
2016 :     else
2017 :     {
2018 :     print "Could not place it in a family\n";
2019 :     }
2020 :    
2021 :     ###############################################
2022 :    
2023 :     =head3 Getting representative sequences for a FIGfam
2024 :    
2025 :     use FIGO;
2026 :     my $figO = new FIGO;
2027 :    
2028 :     $fam = "FIG102446";
2029 :     my $famO = &FigFamO::new('FigFamO',$figO,$fam);
2030 :     my @rep_seqs = $famO->rep_seqs;
2031 :    
2032 :     foreach $seq (@rep_seqs)
2033 :     {
2034 :     print ">query\n$seq\n";
2035 :     }
2036 :    
2037 :     #---------------------------------------------
2038 :    
2039 :     use FIG;
2040 :     use FigFam;
2041 :     use FigFams;
2042 :    
2043 :     my $fig = new FIG;
2044 :    
2045 :     $fam = "FIG102446";
2046 :     my $famO = new FigFam($fig,$fam);
2047 :     my @rep_seqs = $famO->representatives;
2048 :    
2049 :     foreach $seq (@rep_seqs)
2050 :     {
2051 :     print ">query\n$seq\n";
2052 :     }
2053 :    
2054 :    
2055 :     ###############################################
2056 :    
2057 :    
2058 :     =head3 Testing for membership in FIGfam
2059 :    
2060 :     use FIGO;
2061 :     my $figO = new FIGO;
2062 :    
2063 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2064 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2065 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2066 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2067 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2068 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2069 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2070 :     RKLMMNHQ";
2071 :     $seq =~ s/\n//gs;
2072 :    
2073 :     $fam = "FIG102446";
2074 :     my $famO = &FigFamO::new('FigFamO',$figO,$fam);
2075 :     my($should_be, $sims) = $famO->should_be_member($seq);
2076 :    
2077 :     if ($should_be)
2078 :     {
2079 :     print join("\t",($famO->id,$famO->function)),"\n";
2080 :     print &Dumper($sims);
2081 :     }
2082 :     else
2083 :     {
2084 :     print "Sequence should not be added to family\n";
2085 :     }
2086 :    
2087 :     #---------------------------------------------
2088 :    
2089 :     use FIG;
2090 :     use FigFam;
2091 :     use FigFams;
2092 :    
2093 :     my $fig = new FIG;
2094 :    
2095 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2096 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2097 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2098 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2099 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2100 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2101 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2102 :     RKLMMNHQ";
2103 :     $seq =~ s/\n//gs;
2104 :    
2105 :     $fam = "FIG102446";
2106 :     my $famO = new FigFam($fig,$fam);
2107 :     my($should_be, $sims) = $famO->should_be_member($seq);
2108 :    
2109 :     if ($should_be)
2110 :     {
2111 :     print join("\t",($famO->family_id,$famO->family_function)),"\n";
2112 :     print &Dumper($sims);
2113 :     }
2114 :     else
2115 :     {
2116 :     print "Sequence should not be added to family\n";
2117 :     }
2118 :    
2119 :     =cut
2120 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3