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

Diff of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3, Sat Feb 17 17:14:11 2007 UTC revision 1.18, Tue Mar 13 02:38:06 2007 UTC
# Line 1  Line 1 
1    ########################################################################
2  #  #
3  # Copyright (c) 2003-2006 University of Chicago and Fellowship  # Copyright (c) 2003-2006 University of Chicago and Fellowship
4  # for Interpretations of Genomes. All Rights Reserved.  # for Interpretations of Genomes. All Rights Reserved.
# Line 14  Line 15 
15  # Genomes at veronika@thefig.info or download a copy from  # Genomes at veronika@thefig.info or download a copy from
16  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
17  #  #
18    ########################################################################
19    
20  package FIGO;  =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    
47    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 in many cases sidestep the entire issue of inheritance
53    via an I<ad hoc> mechanism:
54    If a "child" object needs access to its "ancestors'" methods,
55    we pass it references to its "ancestors" using subroutine arguments.
56    This is admittedly ugly, clumsy, and potentially error-prone ---
57    but it has the advantage that, unlike multiple inheritance,
58    we understand how to do it...
59    
60    MODULE DEPENDENCIES: FIG, FIG_Config, FigFams, SFXlate, SproutFIG, Tracer,
61        gjoparseblast, Data::Dumper.
62    
63    =cut
64    
65    ########################################################################
66    package FIGO;
67    ########################################################################
68  use strict;  use strict;
69  use FIG;  use FIG;
70  use FIG_Config;  use FIG_Config;
# Line 27  Line 75 
75  use FigFams;  use FigFams;
76  use gjoparseblast;  use gjoparseblast;
77    
78    =head1 FIGO
79    
80    The effective "base class" containing a few "top-level" methods.
81    
82    =cut
83    
84    
85    =head3 new
86    
87    Constructs a new FIGO object.
88    
89    =over 4
90    
91    =item USAGE:
92    
93    C<< my $figo = FIGO->new();           #...Subclass defaults to FIG >>
94    
95    C<< my $figo = FIGO->new('SPROUT');   #...Subclass is a SPROUT object >>
96    
97    =back
98    
99    =cut
100    
101  sub new {  sub new {
102      my($class,$low_level) = @_;      my($class,$low_level) = @_;
103    
# Line 46  Line 117 
117      return bless $self, $class;      return bless $self, $class;
118  }  }
119    
120    
121    
122    =head3 genomes
123    
124    Returns a list of Taxonomy-IDs, possibly constrained by selection criteria.
125    (Default: Empty constraint returns all Tax-IDs in the SEED or SPROUT.)
126    
127    =over 4
128    
129    =item USAGE:
130    
131    C<< my @tax_ids = $figo->genomes(); >>
132    
133    C<< my @tax_ids = $figo->genomes( @constraints ); >>
134    
135    =item @constraints
136    
137        One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
138    
139    =item RETURNS: List of Tax-IDs.
140    
141    =item EXAMPLE:
142    
143    L<Display all complete, prokaryotic genomes>
144    
145    =back
146    
147    =cut
148    
149  sub genomes {  sub genomes {
150      my($self,@constraints) = @_;      my($self,@constraints) = @_;
151      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 90  Line 190 
190      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
191  }  }
192    
193    
194    
195    =head3 subsystems
196    
197    =over 4
198    
199    =item RETURNS:
200    
201        List of all subsystems.
202    
203    =item EXAMPLE:
204    
205    L<Accessing Subsystem data>
206    
207    =back
208    
209    =cut
210    
211  sub subsystems {  sub subsystems {
212      my($self) = @_;      my($self) = @_;
213      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 97  Line 215 
215      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
216  }  }
217    
218    
219    =head3 functional_roles
220    
221    (Not yet implemented)
222    
223    =over
224    
225    =item RETURNS:
226    
227    =item EXAMPLE:
228    
229    =back
230    
231    =cut
232    
233  sub functional_roles {  sub functional_roles {
234      my($self) = @_;      my($self) = @_;
235      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 106  Line 239 
239      return @functional_roles;      return @functional_roles;
240  }  }
241    
242    
243    
244    =head3 all_figfams
245    
246    Returns a list of all FIGfam objects.
247    
248    =over 4
249    
250    =item USAGE:
251    
252    C<< foreach $fam ($figO->all_figfams) { #...Do something } >>
253    
254    =item RETURNS:
255    
256        List of FIGfam Objects
257    
258    =item EXAMPLE:
259    
260    L<Accessing FIGfams>
261    
262    =back
263    
264    =cut
265    
266  sub all_figfams {  sub all_figfams {
267      my($self) = @_;      my($self) = @_;
268      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 113  Line 270 
270      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
271  }  }
272    
273    
274    
275    =head3 family_containing
276    
277    =over 4
278    
279    =item USAGE:
280    
281    C<< my ($fam, $sims) = $figO->family_containing($seq); >>
282    
283    =item $seq:
284    
285        A protein translation string.
286    
287    =item RETURNS:
288    
289          $fam:  A FIGfam Object.
290    
291          $sims: A set of similarity objects.
292    
293    =item EXAMPLE: L<Placing a sequence into a FIGfam>
294    
295    =back
296    
297    =cut
298    
299  sub family_containing {  sub family_containing {
300      my($self,$seq) = @_;      my($self,$seq) = @_;
301    
# Line 129  Line 312 
312      }      }
313  }  }
314    
315  package GenomeO;  =head3 figfam
316    
317    =over 4
318    
319    =item USAGE:
320    
321    C<< my $fam = $figO->figfam($family_id); >>
322    
323    =item $family_id;
324    
325        A FigFam ID
326    
327    =item RETURNS:
328    
329          $fam:  A FIGfam Object.
330    
331    =back
332    
333    =cut
334    
335    sub figfam {
336        my($self,$fam_id) = @_;
337    
338        return &FigFamO::new('FigFamO',$self,$fam_id);
339    }
340    
341    
342    ########################################################################
343    package GenomeO;
344    ########################################################################
345  use Data::Dumper;  use Data::Dumper;
346    
347    =head1 GenomeO
348    
349    =cut
350    
351    
352    =head3 new
353    
354    Constructor of GenomeO objects.
355    
356    =over 4
357    
358    =item USAGE:
359    
360    C<< my $org = GenomeO->new($figo, $tax_id); >>
361    
362    =item RETURNS:
363    
364        A new GenomeO object.
365    
366    =back
367    
368    =cut
369    
370  sub new {  sub new {
371      my($class,$figO,$genomeId) = @_;      my($class,$figO,$genomeId) = @_;
372    
# Line 142  Line 376 
376      return bless $self, $class;      return bless $self, $class;
377  }  }
378    
379    
380    
381    =head3 id
382    
383    =over 4
384    
385    =item USAGE:
386    
387    C<< my $tax_id = $org->id(); >>
388    
389    =item RETURNS:
390    
391        Taxonomy-ID of GenomeO object.
392    
393    =back
394    
395    =cut
396    
397  sub id {  sub id {
398      my($self) = @_;      my($self) = @_;
399    
400      return $self->{_id};      return $self->{_id};
401  }  }
402    
403    
404    
405    =head3 genus_species
406    
407    =over 4
408    
409    =item USAGE:
410    
411    C<< $gs = $genome->genus_species(); >>
412    
413    =item RETURNS:
414    
415        Genus-species-strain string
416    
417    =back
418    
419    =cut
420    
421  sub genus_species {  sub genus_species {
422      my($self) = @_;      my($self) = @_;
423    
# Line 155  Line 425 
425      return $fig->genus_species($self->{_id});      return $fig->genus_species($self->{_id});
426  }  }
427    
428    
429    =head3 contigs_of
430    
431    =over 4
432    
433    =item RETURNS:
434    
435        List of C<contig> objects contained in a C<GenomeO> object.
436    
437    =item EXAMPLE:
438    
439    L<Show how to access contigs and extract sequence>
440    
441    =back
442    
443    =cut
444    
445  sub contigs_of {  sub contigs_of {
446      my($self) = @_;      my($self) = @_;
447    
# Line 163  Line 450 
450      return map { &ContigO::new('ContigO',$figO,$self->id,$_) } $fig->contigs_of($self->id);      return map { &ContigO::new('ContigO',$figO,$self->id,$_) } $fig->contigs_of($self->id);
451  }  }
452    
453    
454    
455    =head3 features_of
456    
457    =cut
458    
459  sub features_of {  sub features_of {
460      my($self,$type) = @_;      my($self,$type) = @_;
461    
# Line 172  Line 465 
465      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
466  }  }
467    
468    
469    =head3 display
470    
471    Prints the genus, species, and strain information about a genome to STDOUT.
472    
473    =over 4
474    
475    =item USAGE:
476    
477    C<< $genome->display(); >>
478    
479    =item RETURNS:
480    
481        (Void)
482    
483    =back
484    
485    =cut
486    
487  sub display {  sub display {
488      my($self) = @_;      my($self) = @_;
489    
490      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
491  }  }
492    
 package ContigO;  
493    
494    
495    ########################################################################
496    package ContigO;
497    ########################################################################
498  use Data::Dumper;  use Data::Dumper;
499    
500    =head1 ContigO
501    
502    Methods for working with DNA sequence objects.
503    
504    =cut
505    
506    =head3 new
507    
508    Contig constructor.
509    
510    =over 4
511    
512    =item USAGE:
513    
514    C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>
515    
516    =item $figO:
517    
518        Parent FIGO object.
519    
520    =item $genomeId:
521    
522        Taxon-ID for the genome the contig is from.
523    
524    =item $contigId:
525    
526        Identifier for the contig
527    
528    =item RETURNS:
529    
530        A "ContigO" object.
531    
532    =back
533    
534    =cut
535    
536  sub new {  sub new {
537      my($class,$figO,$genomeId,$contigId) = @_;      my($class,$figO,$genomeId,$contigId) = @_;
538    
# Line 192  Line 543 
543      return bless $self, $class;      return bless $self, $class;
544  }  }
545    
546    
547    
548    =head3 id
549    
550    =over 4
551    
552    =item RETURNS:
553    
554        Sequence ID string of "ContigO" object
555    
556    =back
557    
558    =cut
559    
560  sub id {  sub id {
561      my($self) = @_;      my($self) = @_;
562    
563      return $self->{_id};      return $self->{_id};
564  }  }
565    
566    
567    =head3 genome
568    
569    =over 4
570    
571    =item USAGE:
572    
573    C<< my $tax_id = $contig->genome->id(); >>
574    
575    =item RETURNS:
576    
577        Tax-ID of the GenomeO object containing the contig object.
578    
579    =back
580    
581    =cut
582    
583  sub genome {  sub genome {
584      my($self) = @_;      my($self) = @_;
585    
586      return $self->{_genome};      my $figO = $self->{_figO};
587        return new GenomeO($figO,$self->{_genome});
588  }  }
589    
590    
591    
592    =head3 contig_length
593    
594    =over 4
595    
596    =item USAGE:
597    
598    C<< my $len = $contig->contig_length(); >>
599    
600    =item RETURNS:
601    
602        Length of contig's DNA sequence.
603    
604    =back
605    
606    =cut
607    
608  sub contig_length {  sub contig_length {
609      my($self) = @_;      my($self) = @_;
610    
611      my $fig = $self->{_figO}->{_fig};      my $fig = $self->{_figO}->{_fig};
612      my $contig_lengths = $fig->contig_lengths($self->genome);      my $contig_lengths = $fig->contig_lengths($self->genome->id);
613      return $contig_lengths->{$self->id};      return $contig_lengths->{$self->id};
614  }  }
615    
616    
617    =head3 dna_seq
618    
619    =over 4
620    
621    =item USAGE:
622    
623    C<< my $seq = $contig->dna_seq(beg, $end); >>
624    
625    =item $beg:
626    
627        Begining point of DNA subsequence
628    
629    =item $end:
630    
631        End point of DNA subsequence
632    
633    =item RETURNS:
634    
635        string of DNA sequence running from $beg to $end
636        (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
637    
638    =back
639    
640    =cut
641    
642  sub dna_seq {  sub dna_seq {
643      my($self,$beg,$end) = @_;      my($self,$beg,$end) = @_;
644    
# Line 220  Line 647 
647      if (($beg && (&FIG::between(1,$beg,$max))) &&      if (($beg && (&FIG::between(1,$beg,$max))) &&
648          ($end && (&FIG::between(1,$end,$max))))          ($end && (&FIG::between(1,$end,$max))))
649      {      {
650          return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));          return $fig->dna_seq($self->genome->id,join("_",($self->id,$beg,$end)));
651      }      }
652      else      else
653      {      {
# Line 228  Line 655 
655      }      }
656  }  }
657    
 sub display {  
     my($self) = @_;  
658    
659      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";  =head3 display
 }  
660    
661  package FeatureO;  Prints summary information about a "ContigO" object to STDOUT:
662    
663  use Data::Dumper;  Genus, species, strain
664    
665  sub new {  Contig ID
     my($class,$figO,$fid) = @_;  
666    
667      ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;  Contig length
     my $self = {};  
     $self->{_figO} = $figO;  
     $self->{_id} = $fid;  
     return bless $self, $class;  
 }  
668    
669  sub id {  =over 4
     my($self) = @_;  
670    
671      return $self->{_id};  =item RETURNS:
 }  
672    
673  sub genome {      (Void)
     my($self) = @_;  
674    
675      $self->id =~ /^fig\|(\d+\.\d+)/;  =back
     return $1;  
 }  
676    
677  sub type {  =cut
678    
679    sub display {
680      my($self) = @_;      my($self) = @_;
681    
682      $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;      print join("ContigO",$self->genome->id,$self->id,$self->contig_length),"\n";
     return $1;  
683  }  }
684    
685  sub location {  sub features_in_region {
686      my($self) = @_;      my($self,$beg,$end) = @_;
687        my $figO = $self->{_figO};
688        my $fig = $figO->{_fig};
689    
690      my $fig = $self->{_figO}->{_fig};      my($features) = $fig->genes_in_region($self->genome->id,$self->id,$beg,$end);
691      return scalar $fig->feature_location($self->id);      return map { new FeatureO($figO,$_) } @$features;
692  }  }
693    
 sub dna_seq {  
     my($self) = @_;  
694    
695      my $fig = $self->{_figO}->{_fig};  
696      my $fid = $self->id;  ########################################################################
697    package FeatureO;
698    ########################################################################
699    use Data::Dumper;
700    
701    =head1 FeatureO
702    
703    Methods for working with features on "ContigO" objects.
704    
705    =cut
706    
707    
708    =head3 new
709    
710    Constructor of "FeatureO" objects
711    
712    =over 4
713    
714    =item USAGE:
715    
716    C<< my $feature = FeatureO->new( $figO, $fid ); >>
717    
718    =item C<$figO>:
719    
720    "Base" FIGO object.
721    
722    =item C<$fid>:
723    
724    Feature-ID for new feature
725    
726    =item RETURNS:
727    
728    A newly created "FeatureO" object.
729    
730    =back
731    
732    =cut
733    
734    sub new {
735        my($class,$figO,$fid) = @_;
736    
737        ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
738        my $self = {};
739        $self->{_figO} = $figO;
740        $self->{_id} = $fid;
741        return bless $self, $class;
742    }
743    
744    
745    
746    =head3 id
747    
748    =over 4
749    
750    =item USAGE:
751    
752    C<< my $fid = $feature->id(); >>
753    
754    =item RETURNS:
755    
756    The FID (Feature ID) of a "FeatureO" object.
757    
758    =back
759    
760    =cut
761    
762    sub id {
763        my($self) = @_;
764    
765        return $self->{_id};
766    }
767    
768    
769    
770    =head3 genome
771    
772    =over 4
773    
774    =item USAGE:
775    
776    C<< my $taxid = $feature->genome(); >>
777    
778    =item RETURNS:
779    
780    The TAxon-ID for the "GenomeO" object containg the feature.
781    
782    =back
783    
784    =cut
785    
786    sub genome {
787        my($self) = @_;
788        my $figO = $self->{_figO};
789        $self->id =~ /^fig\|(\d+\.\d+)/;
790        return new GenomeO($figO,$1);
791    }
792    
793    
794    
795    =head3 type
796    
797    =over 4
798    
799    =item USAGE:
800    
801    C<< my $feature_type = $feature->type(); >>
802    
803    =item RETURNS:
804    
805    The feature object's "type" (e.g., "peg," "rna," etc.)
806    
807    =back
808    
809    =cut
810    
811    sub type {
812        my($self) = @_;
813    
814        $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
815        return $1;
816    }
817    
818    
819    
820    =head3 location
821    
822    =over 4
823    
824    =item USAGE:
825    
826    C<< my $loc = $feature->location(); >>
827    
828    =item RETURNS:
829    
830    A string representing the feature object's location on the genome's DNA,
831    in SEED "tbl format" (i.e., "contig_beging_end").
832    
833    =back
834    
835    =cut
836    
837    sub location {
838        my($self) = @_;
839    
840        my $fig = $self->{_figO}->{_fig};
841        return scalar $fig->feature_location($self->id);
842    }
843    
844    
845    =head3 contig
846    
847    =over 4
848    
849    =item USAGE:
850    
851    C<< my $contig = $feature->contig(); >>
852    
853    =item RETURNS:
854    
855    A "ContigO" object to access the contig data
856    for the contig the feature is on.
857    
858    =back
859    
860    =cut
861    
862    sub contig {
863        my($self) = @_;
864    
865        my $figO = $self->{_figO};
866        my $loc      = $self->location;
867        my $genomeID = $self->genome->id;
868        return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;
869    }
870    
871    
872    
873    =head3 begin
874    
875    =over 4
876    
877    =item USAGE:
878    
879    C<< my $beg = $feature->begin(); >>
880    
881    =item RETURNS:
882    
883    The numerical coordinate of the first base of the feature.
884    
885    =back
886    
887    =cut
888    
889    sub begin {
890        my($self) = @_;
891    
892        my $loc = $self->location;
893        return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
894    }
895    
896    
897    
898    =head3 end
899    
900    =over 4
901    
902    =item USAGE:
903    
904    C<< my $end = $feature->end(); >>
905    
906    =item RETURNS:
907    
908    The numerical coordinate of the last base of the feature.
909    
910    =back
911    
912    =cut
913    
914    sub end {
915        my($self) = @_;
916    
917        my $loc = $self->location;
918        return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
919    }
920    
921    
922    
923    =head3 dna_seq
924    
925    =over 4
926    
927    =item USAGE:
928    
929    C<< my $dna_seq = $feature->dna_seq(); >>
930    
931    =item RETURNS:
932    
933    A string contining the DNA subsequence of the contig
934    running from the first to the last base of the feature.
935    
936    If ($beg > $end), the reverse complement subsequence is returned.
937    
938    =back
939    
940    =cut
941    
942    sub dna_seq {
943        my($self) = @_;
944    
945        my $fig = $self->{_figO}->{_fig};
946        my $fid = $self->id;
947      my @loc = $fig->feature_location($fid);      my @loc = $fig->feature_location($fid);
948      return $fig->dna_seq(&FIG::genome_of($fid),@loc);      return $fig->dna_seq(&FIG::genome_of($fid),@loc);
949  }  }
950    
951    
952    
953    =head3 prot_seq
954    
955    =over 4
956    
957    =item USAGE:
958    
959    C<< my $dna_seq = $feature->prot_seq(); >>
960    
961    =item RETURNS:
962    
963    A string contining the protein translation of the feature (if it exists),
964    or the "undef" value if the feature does not exist or is not a PEG.
965    
966    =back
967    
968    =cut
969    
970  sub prot_seq {  sub prot_seq {
971      my($self) = @_;      my($self) = @_;
972    
# Line 293  Line 976 
976      return $fig->get_translation($fid);      return $fig->get_translation($fid);
977  }  }
978    
979    
980    
981    =head3 function_of
982    
983    =over 4
984    
985    =item USAGE:
986    
987    C<< my $func = $feature->function_of(); >>
988    
989    =item RETURNS:
990    
991    A string containing the function assigned to the feature,
992    or the "undef" value if no function has been assigned.
993    
994    =back
995    
996    =cut
997    
998  sub function_of {  sub function_of {
999      my($self) = @_;      my($self) = @_;
1000    
# Line 301  Line 1003 
1003      return scalar $fig->function_of($fid);      return scalar $fig->function_of($fid);
1004  }  }
1005    
1006    
1007    
1008    =head3 coupled_to
1009    
1010    =over 4
1011    
1012    =item USAGE:
1013    
1014    C<< my @coupled_features = $feature->coupled_to(); >>
1015    
1016    =item RETURNS:
1017    
1018    A list of L<CouplingO> objects describing the evidence for functional coupling
1019    between this feature and other nearby features.
1020    
1021    =back
1022    
1023    =cut
1024    
1025  sub coupled_to {  sub coupled_to {
1026      my($self) = @_;      my($self) = @_;
1027    
1028      ($self->type eq "peg") || return undef;      ($self->type eq "peg") || return ();
1029      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1030      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1031      my $peg1 = $self->id;      my $peg1 = $self->id;
# Line 317  Line 1038 
1038      return @coupled;      return @coupled;
1039  }  }
1040    
1041    
1042    
1043    =head3 annotations
1044    
1045    =over 4
1046    
1047    =item USAGE:
1048    
1049    C<< my @annot_list = $feature->annotations(); >>
1050    
1051    =item RETURNS:
1052    
1053    A list of L<AnnotationO> objects allowing access to the annotations for this feature.
1054    
1055    =back
1056    
1057    =cut
1058    
1059  sub annotations {  sub annotations {
1060      my($self) = @_;      my($self) = @_;
1061    
# Line 326  Line 1065 
1065      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
1066  }  }
1067    
1068    
1069    =head3 in_subsystems
1070    
1071    =over 4
1072    
1073    =item USAGE:
1074    
1075    C<< my @subsys_list = $feature->in_subsystems(); >>
1076    
1077    =item RETURNS:
1078    
1079    A list of L<SubsystemO> objects allowing access to the subsystems
1080    that this feature particupates in.
1081    
1082    =back
1083    
1084    =cut
1085    
1086    sub in_subsystems {
1087        my($self) = @_;
1088        my $figO = $self->{_figO};
1089        my $fig  = $figO->{_fig};
1090    
1091        return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);
1092    }
1093    
1094    
1095    =head3 possibly_truncated
1096    
1097    =over 4
1098    
1099    =item USAGE:
1100    
1101    C<< my $trunc = $feature->possibly_truncated(); >>
1102    
1103    =item RETURNS:
1104    
1105    Boolean C<TRUE> if the feature may be truncated;
1106    boolean C<FALSE> otherwise.
1107    
1108    =back
1109    
1110    =cut
1111    
1112  sub possibly_truncated {  sub possibly_truncated {
1113      my($self) = @_;      my($self) = @_;
1114      my $figO = $self->{_figO};      my $figO = $self->{_figO};
# Line 334  Line 1117 
1117      return $fig->possibly_truncated($self->id);      return $fig->possibly_truncated($self->id);
1118  }  }
1119    
1120    
1121    
1122    =head3 possible_frameshift
1123    
1124    =over 4
1125    
1126    =item USAGE:
1127    
1128    C<< my $fs = $feature->possible_frameshift(); >>
1129    
1130    =item RETURNS:
1131    
1132    Boolean C<TRUE> if the feature may be a frameshifted fragment;
1133    boolean C<FALSE> otherwise.
1134    
1135    (NOTE: This is a crude prototype implementation,
1136    and is mostly as an example of how to code using FIGO.)
1137    
1138    =back
1139    
1140    =cut
1141    
1142  sub possible_frameshift {  sub possible_frameshift {
1143      my($self) = @_;      my($self) = @_;
1144      my $figO = $self->{_figO};      my $figO = $self->{_figO};
# Line 359  Line 1164 
1164                      my $contig = $1;                      my $contig = $1;
1165                      my $beg    = $2;                      my $beg    = $2;
1166                      my $end = $3;                      my $end = $3;
1167                      my $contigO = new ContigO($figO,$self->genome,$contig);                      my $contigO = new ContigO($figO,$self->genome->id,$contig);
1168                      my $begA = &max(1,$beg - $adjL);                      my $begA = &max(1,$beg - $adjL);
1169                      my $endA = &min($end+$adjR,$contigO->contig_length);                      my $endA = &min($end+$adjR,$contigO->contig_length);
1170                      my $dna  = $contigO->dna_seq($begA,$endA);                      my $dna  = $contigO->dna_seq($begA,$endA);
# Line 383  Line 1188 
1188                                       @{$db_seq_out->[6]};                                       @{$db_seq_out->[6]};
1189                      my @prot = map { [$_->[0],$_->[1]] } @hsps;                      my @prot = map { [$_->[0],$_->[1]] } @hsps;
1190                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;
1191                      if (&covers(\@prot,length($prot),3) && &covers(\@dna,3*length($prot),9))                      if (&covers(\@prot,length($prot),3,0) && &covers(\@dna,3*length($prot),9,1))
1192                      {                      {
1193                          return 1;                          return 1;
1194                      }                      }
# Line 394  Line 1199 
1199      return 0;      return 0;
1200  }  }
1201    
1202    
1203    
1204    =head3 run
1205    
1206    (Note: This function should be considered "PRIVATE")
1207    
1208    =over 4
1209    
1210    =item FUNCTION:
1211    
1212    Passes a string containing a command to be execture by the "system" shell command.
1213    
1214    =item USAGE:
1215    
1216    C<< $feature->run($cmd); >>
1217    
1218    =item RETURNS:
1219    
1220    Nil if the execution of C<$cmd> was successful;
1221    aborts with traceback if C<$cmd> fails.
1222    
1223    =back
1224    
1225    =cut
1226    
1227  sub run {  sub run {
1228      my($cmd) = @_;      my($cmd) = @_;
1229      (system($cmd) == 0) || Confess("FAILED: $cmd");      (system($cmd) == 0) || Confess("FAILED: $cmd");
1230  }  }
1231    
 sub max {  
     my($x,$y) = @_;  
     return ($x < $y) ? $y : $x;  
 }  
1232    
 sub min {  
     my($x,$y) = @_;  
     return ($x < $y) ? $x : $y;  
 }  
1233    
1234  sub covers {  =head3 max
1235      my($hsps,$ln,$diff) = @_;  
1236    (Note: This function should be considered "PRIVATE")
1237    
1238    =over 4
1239    
1240    =item USAGE:
1241    
1242    C<< my $max = $feature->max($x, $y); >>
1243    
1244    =item C<$x>
1245    
1246    Numerical value.
1247    
1248    =item C<$y>
1249    
1250    Numerical value.
1251    
1252    =items RETURNS:
1253    
1254    The larger of the two numerical values C<$x> and C<$y>.
1255    
1256    =back
1257    
1258    =cut
1259    
1260    sub max {
1261        my($x,$y) = @_;
1262        return ($x < $y) ? $y : $x;
1263    }
1264    
1265    
1266    
1267    =head3 min
1268    
1269    (Note: This function should be considered "PRIVATE")
1270    
1271    =over 4
1272    
1273    =item USAGE:
1274    
1275    C<< my $min = $feature->min($x, $y); >>
1276    
1277    =item C<$x>
1278    
1279    Numerical value.
1280    
1281    =item C<$y>
1282    
1283    Numerical value.
1284    
1285    =item RETURNS:
1286    
1287    The smaller of the two numerical values C<$x> and C<$y>.
1288    
1289    =back
1290    
1291    =cut
1292    
1293    sub min {
1294        my($x,$y) = @_;
1295        return ($x < $y) ? $x : $y;
1296    }
1297    
1298    
1299    
1300    =head3 covers
1301    
1302    (Question: Should this function be considered "PRIVATE" ???)
1303    
1304    USAGE:
1305        C<< if (&covers(\@hits, $len, $diff, $must_shift)) { #...Do stuff } >>
1306    
1307    Returns boolean C<TRUE> if a set of BLAST HSPs "cover" more than 90%
1308    of the database sequence(?).
1309    
1310    =cut
1311    
1312    sub covers {
1313        my($hsps,$ln,$diff,$must_shift) = @_;
1314    
1315      my $hsp1 = shift @$hsps;      my $hsp1 = shift @$hsps;
1316      my $hsp2;      my $hsp2;
1317      while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}      my $merged = 0;
1318      return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));      while ($hsp1 && ($hsp2 = shift @$hsps) &&
1319               ($must_shift ? &diff_frames($hsp1,$hsp2) : 1) &&
1320               ($hsp1 = &merge($hsp1,$hsp2,$diff))) { $merged = 1 }
1321        return ($merged && $hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
1322    }
1323    
1324    sub diff_frames {
1325        my($hsp1,$hsp2) = @_;
1326        return (($hsp1->[0] % 3) != ($hsp2->[0] % 3));
1327  }  }
1328    
1329    
1330    
1331    =head3 merge
1332    
1333    Merge two HSPs unless their overlap or separation is too large.
1334    
1335    RETURNS: Merged boundaries if merger succeeds, and C<undef> if merger fails.
1336    
1337    =cut
1338    
1339  sub merge {  sub merge {
1340      my($hsp1,$hsp2,$diff) = @_;      my($hsp1,$hsp2,$diff) = @_;
1341    
# Line 426  Line 1344 
1344      return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;      return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;
1345  }  }
1346    
1347    
1348    
1349    =head3 sims
1350    
1351    =over 4
1352    
1353    =item FUNCTION:
1354    
1355    Returns precomputed "Sim.pm" objects from the SEED.
1356    
1357    =item USAGE:
1358    
1359    C<< my @sims = $pegO->sims( -all, -cutoff => 1.0e-10); >>
1360    
1361    C<< my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10); >>
1362    
1363    =item RETURNS: List of sim objects.
1364    
1365    =back
1366    
1367    =cut
1368    
1369  use Sim;  use Sim;
1370  sub sims {  sub sims {
1371      my($self,%args) = @_;      my($self,%args) = @_;
# Line 440  Line 1380 
1380      return $fig->sims($self->id,$max,$cutoff,$all);      return $fig->sims($self->id,$max,$cutoff,$all);
1381  }  }
1382    
1383    
1384    
1385    =head3 bbhs
1386    
1387    =over 4
1388    
1389    =item FUNCTION:
1390    
1391    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1392    corresponding to the pre-computed BBHs for that PEG.
1393    
1394    =item USAGE:
1395    
1396    C<< my @bbhs = $pegO->bbhs(); >>
1397    
1398    =item List of BBHO objects.
1399    
1400    =back
1401    
1402    =cut
1403    
1404  sub bbhs {  sub bbhs {
1405      my($self) = @_;      my($self) = @_;
1406    
# Line 447  Line 1408 
1408      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1409    
1410      my @bbhs  = $fig->bbhs($self->id);      my @bbhs  = $fig->bbhs($self->id);
1411      return map { my($peg2,$sc,$bs) = @$_; bless({ _peg1 => $self->id,      return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
1412                                                      _peg1 => $self->id,
1413                                                    _peg2 => $peg2,                                                    _peg2 => $peg2,
1414                                                    _psc => $sc,                                                    _psc => $sc,
1415                                                    _bit_score => $bs                                                    _bit_score => $bs
1416                                                  },'BBHO') } @bbhs;                                                  },'BBHO') } @bbhs;
1417  }  }
1418    
1419    =head3 display
1420    
1421    Prints info about a "FeatureO" object to STDOUT.
1422    
1423    USAGE:
1424    
1425    C<< $pegO->display(); >>
1426    
1427    =cut
1428    
1429  sub display {  sub display {
1430      my($self) = @_;      my($self) = @_;
1431    
# Line 462  Line 1434 
1434            $self->prot_seq,"\n";            $self->prot_seq,"\n";
1435  }  }
1436    
1437    
1438    
1439    ########################################################################
1440  package BBHO;  package BBHO;
1441    ########################################################################
1442    
1443    =head1 BBHO
1444    
1445    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1446    
1447    =cut
1448    
1449    
1450    =head3 new
1451    
1452    Constructor of BBHO objects.
1453    
1454    (NOTE: The "average user" should never need to invoke this method.)
1455    
1456    =cut
1457    
1458  sub new {  sub new {
1459      my($class,$peg1,$peg2,$sc,$normalized_bitscore) = @_;      my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
1460    
1461      my $self = {};      my $self = {};
1462        $self->{_figO}      = $figO;
1463      $self->{_peg1}      = $peg1;      $self->{_peg1}      = $peg1;
1464      $self->{_peg2}      = $peg2;      $self->{_peg2}      = $peg2;
1465      $self->{_psc}       = $sc;      $self->{_psc}       = $sc;
# Line 475  Line 1467 
1467    
1468  }  }
1469    
1470    
1471    
1472    =head3 peg1
1473    
1474    =over 4
1475    
1476    =item USAGE:
1477    
1478    C<< my $peg1 = $bbh->peg1(); >>
1479    
1480    =item RETURNS:
1481    
1482    A "FeatureO" object corresponding to the "query" sequence
1483    in a BBH pair.
1484    
1485    =back
1486    
1487    =cut
1488    
1489  sub peg1 {  sub peg1 {
1490      my($self) = @_;      my($self) = @_;
1491    
1492      return $self->{_peg1};      my $figO = $self->{_figO};
1493        return new FeatureO($figO,$self->{_peg1});
1494  }  }
1495    
1496    =head3 peg2
1497    
1498    =over 4
1499    
1500    =item USAGE:
1501    
1502    C<< my $peg2 = $bbh->peg2(); >>
1503    
1504    =item RETURNS:
1505    
1506    A "FeatureO" object corresponding to the "database" sequence
1507    in a BBH pair.
1508    
1509    =back
1510    
1511    =cut
1512    
1513  sub peg2 {  sub peg2 {
1514      my($self) = @_;      my($self) = @_;
1515    
1516      return $self->{_peg2};      my $figO = $self->{_figO};
1517        return new FeatureO($figO,$self->{_peg2});
1518  }  }
1519    
1520    
1521    
1522    =head3 psc
1523    
1524    =over 4
1525    
1526    =item USAGE:
1527    
1528    C<< my $psc = $bbh->psc(); >>
1529    
1530    =item RETURNS:
1531    
1532    The numerical value of the BLAST E-value for the pair.
1533    
1534    =back
1535    
1536    =cut
1537    
1538  sub psc {  sub psc {
1539      my($self) = @_;      my($self) = @_;
1540    
1541      return $self->{_psc};      return $self->{_psc};
1542  }  }
1543    
1544    
1545    
1546    =head3 norm_bitscore
1547    
1548    
1549    =over 4
1550    
1551    =item USAGE:
1552    
1553    C<< my $bsc = $bbh->norm_bitscore(); >>
1554    
1555    =item RETURNS:
1556    
1557    The "BLAST bit-score per aligned character" for the pair.
1558    
1559    =back
1560    
1561    =cut
1562    
1563  sub norm_bitscore {  sub norm_bitscore {
1564      my($self) = @_;      my($self) = @_;
1565    
1566      return $self->{_bit_score};      return $self->{_bit_score};
1567  }  }
1568    
1569    
1570    
1571    ########################################################################
1572  package AnnotationO;  package AnnotationO;
1573    ########################################################################
1574    
1575    =head1 AnnotationO
1576    
1577    Methods for accessing SEED annotations.
1578    
1579    =cut
1580    
1581    
1582    
1583    =head3 new
1584    
1585    =cut
1586    
1587  sub new {  sub new {
1588      my($class,$fid,$timestamp,$who,$text) = @_;      my($class,$fid,$timestamp,$who,$text) = @_;
# Line 512  Line 1595 
1595      return bless $self, $class;      return bless $self, $class;
1596  }  }
1597    
1598    
1599    
1600    =head3 fid
1601    
1602    =cut
1603    
1604  sub fid {  sub fid {
1605      my($self) = @_;      my($self) = @_;
1606    
1607      return $self->{_fid};      return $self->{_fid};
1608  }  }
1609    
1610    
1611    
1612    =head3 timestamp
1613    
1614    =cut
1615    
1616  sub timestamp {  sub timestamp {
1617      my($self,$convert) = @_;      my($self,$convert) = @_;
1618    
# Line 531  Line 1626 
1626      }      }
1627  }  }
1628    
1629    
1630    
1631    =head3 made_by
1632    
1633    =cut
1634    
1635  sub made_by {  sub made_by {
1636      my($self) = @_;      my($self) = @_;
1637    
# Line 539  Line 1640 
1640      return $who;      return $who;
1641  }  }
1642    
1643    
1644    
1645    =head3 text
1646    
1647    =cut
1648    
1649  sub text {  sub text {
1650      my($self) = @_;      my($self) = @_;
1651    
# Line 546  Line 1653 
1653      return $text;      return $text;
1654  }  }
1655    
1656    
1657    =head3 display
1658    
1659    =cut
1660    
1661  sub display {  sub display {
1662      my($self) = @_;      my($self) = @_;
1663    
1664      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1665  }  }
1666    
 package CouplingO;  
1667    
1668    
1669    ########################################################################
1670    package CouplingO;
1671    ########################################################################
1672  use Data::Dumper;  use Data::Dumper;
1673    
1674    =head1 CouplingO
1675    
1676    Methods for accessing the "Functional coupling scores"
1677    of PEGs in close physical proximity to each other.
1678    
1679    =cut
1680    
1681    
1682    
1683    =head3 new
1684    
1685    =cut
1686    
1687  sub new {  sub new {
1688      my($class,$figO,$peg1,$peg2,$sc) = @_;      my($class,$figO,$peg1,$peg2,$sc) = @_;
1689    
# Line 569  Line 1697 
1697      return bless $self, $class;      return bless $self, $class;
1698  }  }
1699    
1700    
1701    
1702    =head3 peg1
1703    
1704    =cut
1705    
1706  sub peg1 {  sub peg1 {
1707      my($self) = @_;      my($self) = @_;
1708    
1709      return $self->{_peg1};      my $figO = $self->{_figO};
1710        return new FeatureO($figO,$self->{_peg1});
1711  }  }
1712    
1713    
1714    
1715    =head3 peg1
1716    
1717    =cut
1718    
1719  sub peg2 {  sub peg2 {
1720      my($self) = @_;      my($self) = @_;
1721    
1722      return $self->{_peg2};      my $figO = $self->{_figO};
1723        return new FeatureO($figO,$self->{_peg2});
1724  }  }
1725    
1726    
1727    
1728    =head3 sc
1729    
1730    =cut
1731    
1732  sub sc {  sub sc {
1733      my($self) = @_;      my($self) = @_;
1734    
1735      return $self->{_sc};      return $self->{_sc};
1736  }  }
1737    
1738    
1739    
1740    =head3 evidence
1741    
1742    =cut
1743    
1744  sub evidence {  sub evidence {
1745      my($self) = @_;      my($self) = @_;
1746    
# Line 603  Line 1757 
1757      return @ev;      return @ev;
1758  }  }
1759    
1760    
1761    
1762    =head3 display
1763    
1764    =cut
1765    
1766  sub display {  sub display {
1767      my($self) = @_;      my($self) = @_;
1768    
1769      print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";      print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1770  }  }
1771    
 package SubsystemO;  
1772    
1773    
1774    ########################################################################
1775    package SubsystemO;
1776    ########################################################################
1777  use Data::Dumper;  use Data::Dumper;
1778  use Subsystem;  use Subsystem;
1779    
1780    =head1 SubsystemO
1781    
1782    =cut
1783    
1784    
1785    
1786    =head3 new
1787    
1788    =cut
1789    
1790  sub new {  sub new {
1791      my($class,$figO,$name) = @_;      my($class,$figO,$name) = @_;
1792    
# Line 624  Line 1797 
1797      return bless $self, $class;      return bless $self, $class;
1798  }  }
1799    
1800    
1801    
1802    =head3 id
1803    
1804    =cut
1805    
1806  sub id {  sub id {
1807      my($self) = @_;      my($self) = @_;
1808    
1809      return $self->{_id};      return $self->{_id};
1810  }  }
1811    
1812    
1813    
1814    =head3 usable
1815    
1816    
1817    =cut
1818    
1819  sub usable {  sub usable {
1820      my($self) = @_;      my($self) = @_;
1821    
# Line 638  Line 1824 
1824      return $fig->usable_subsystem($self->id);      return $fig->usable_subsystem($self->id);
1825  }  }
1826    
1827    
1828    
1829    =head3 genomes
1830    
1831    =cut
1832    
1833  sub genomes {  sub genomes {
1834      my($self) = @_;      my($self) = @_;
1835    
# Line 648  Line 1840 
1840      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1841  }  }
1842    
1843    
1844    
1845    =head3 roles
1846    
1847    =cut
1848    
1849  sub roles {  sub roles {
1850      my($self) = @_;      my($self) = @_;
1851    
# Line 658  Line 1856 
1856      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);
1857  }  }
1858    
1859    
1860    
1861    =head3 curator
1862    
1863    =cut
1864    
1865  sub curator {  sub curator {
1866      my($self) = @_;      my($self) = @_;
1867    
# Line 668  Line 1872 
1872      return $subO->get_curator;      return $subO->get_curator;
1873  }  }
1874    
1875    
1876    
1877    
1878    =head3 variant
1879    
1880    =cut
1881    
1882  sub variant {  sub variant {
1883      my($self,$genome) = @_;      my($self,$genome) = @_;
1884    
# Line 678  Line 1889 
1889      return $subO->get_variant_code_for_genome($genome->id);      return $subO->get_variant_code_for_genome($genome->id);
1890  }  }
1891    
1892    
1893    
1894    =head3 pegs_in_cell
1895    
1896    =cut
1897    
1898  sub pegs_in_cell {  sub pegs_in_cell {
1899      my($self,$genome,$role) = @_;      my($self,$genome,$role) = @_;
1900    
# Line 688  Line 1905 
1905      return $subO->get_pegs_from_cell($genome->id,$role->id);      return $subO->get_pegs_from_cell($genome->id,$role->id);
1906  }  }
1907    
 package FunctionalRoleO;  
1908    
1909    
1910    ########################################################################
1911    package FunctionalRoleO;
1912    ########################################################################
1913  use Data::Dumper;  use Data::Dumper;
1914    
1915    =head1 FunctionalRoleO
1916    
1917    Methods for accessing the functional roles of features.
1918    
1919    =cut
1920    
1921    
1922    =head3 new
1923    
1924    =cut
1925    
1926  sub new {  sub new {
1927      my($class,$figO,$fr) = @_;      my($class,$figO,$fr) = @_;
1928    
# Line 701  Line 1932 
1932      return bless $self, $class;      return bless $self, $class;
1933  }  }
1934    
1935    
1936    
1937    =head3 id
1938    
1939    =cut
1940    
1941  sub id {  sub id {
1942      my($self) = @_;      my($self) = @_;
1943    
1944      return $self->{_id};      return $self->{_id};
1945  }  }
1946    
 package FigFamO;  
1947    
1948    
1949    ########################################################################
1950    package FigFamO;
1951    ########################################################################
1952  use FigFams;  use FigFams;
1953  use FigFam;  use FigFam;
1954    
1955    
1956    =head1 FigFamO
1957    
1958    =cut
1959    
1960    
1961    =head3 new
1962    
1963    =cut
1964    
1965  sub new {  sub new {
1966      my($class,$figO,$id) = @_;      my($class,$figO,$id) = @_;
1967    
# Line 721  Line 1971 
1971      return bless $self, $class;      return bless $self, $class;
1972  }  }
1973    
1974    
1975    
1976    =head3 id
1977    
1978    =cut
1979    
1980  sub id {  sub id {
1981      my($self) = @_;      my($self) = @_;
1982    
1983      return $self->{_id};      return $self->{_id};
1984  }  }
1985    
1986    
1987    =head3 function
1988    
1989    =cut
1990    
1991  sub function {  sub function {
1992      my($self) = @_;      my($self) = @_;
1993    
# Line 737  Line 1998 
1998      return $famO->family_function;      return $famO->family_function;
1999  }  }
2000    
2001    
2002    
2003    =head3 members
2004    
2005    =cut
2006    
2007  sub members {  sub members {
2008      my($self) = @_;      my($self) = @_;
2009    
# Line 745  Line 2012 
2012      my $famO = $self->{_famO};      my $famO = $self->{_famO};
2013      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2014    
2015      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2016  }  }
2017    
2018    =head3 rep_seqs
2019    
2020    =cut
2021    
2022  sub rep_seqs {  sub rep_seqs {
2023      my($self) = @_;      my($self) = @_;
2024    
# Line 759  Line 2030 
2030      return $famO->representatives;      return $famO->representatives;
2031  }  }
2032    
2033    
2034    
2035    =head3 should_be_member
2036    
2037    =cut
2038    
2039  sub should_be_member {  sub should_be_member {
2040      my($self,$seq) = @_;      my($self,$seq) = @_;
2041    
# Line 772  Line 2049 
2049    
2050    
2051    
2052    =head3 display
2053    
2054    =cut
2055    
2056  sub display {  sub display {
2057      my($self) = @_;      my($self) = @_;
2058    
# Line 780  Line 2061 
2061    
2062    
2063    
2064    ########################################################################
2065  package Attribute;  package Attribute;
2066    ########################################################################
2067    =head1 Attribute
2068    
2069    (Note yet implemented.)
2070    
2071    =cut
2072    
2073  1;  1;
2074    __END__
2075    
2076    =head1 Examples
2077    
2078    =head3 Display all complete, prokaryotic genomes
2079    
2080    use FIGO;
2081    my $figO = new FIGO;
2082    
2083    foreach $genome ($figO->genomes('complete','prokaryotic'))
2084    {
2085        $genome->display;
2086    }
2087    
2088    #---------------------------------------------
2089    
2090    use FIG;
2091    my $fig = new FIG;
2092    
2093    foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
2094    {
2095        print join("\t",("Genome",$genome,$fig->genus_species($genome))),"\n";
2096    }
2097    
2098    ###############################################
2099    
2100    =head3 Show how to access contigs and extract sequence
2101    
2102    use FIGO;
2103    my $figO = new FIGO;
2104    
2105    $genomeId = '83333.1';
2106    my $genome = new GenomeO($figO,$genomeId);
2107    
2108    foreach $contig ($genome->contigs_of)
2109    {
2110        $tag1 = $contig->dna_seq(1,10);
2111        $tag2 = $contig->dna_seq(10,1);
2112        print join("\t",($tag1,$tag2,$contig->id,$contig->contig_length)),"\n";
2113    }
2114    
2115    #---------------------------------------------
2116    
2117    use FIG;
2118    my $fig = new FIG;
2119    
2120    $genomeId = '83333.1';
2121    
2122    $contig_lengths = $fig->contig_lengths($genomeId);
2123    
2124    foreach $contig ($fig->contigs_of($genomeId))
2125    {
2126        $tag1 = $fig->dna_seq($genomeId,join("_",($contig,1,10)));
2127        $tag2 = $fig->dna_seq($genomeId,join("_",($contig,10,1)));
2128        print join("\t",($tag1,$tag2,$contig,$contig_lengths->{$contig})),"\n";
2129    }
2130    
2131    ###############################################
2132    
2133    ### accessing data related to features
2134    
2135    use FIGO;
2136    my $figO = new FIGO;
2137    
2138    my $genome = new GenomeO($figO,"83333.1");
2139    my $peg  = "fig|83333.1.peg.4";
2140    my $pegO = new FeatureO($figO,$peg);
2141    
2142    print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
2143          $pegO->dna_seq,"\n",
2144          $pegO->prot_seq,"\n";
2145    
2146    foreach $fidO ($genome->features_of('rna'))
2147    {
2148        print join("\t",$fidO->id,$fidO->location,$fidO->function_of),"\n";
2149    }
2150    
2151    #---------------------------------------------
2152    
2153    
2154    use FIG;
2155    my $fig = new FIG;
2156    
2157    my $genome = "83333.1";
2158    my $peg  = "fig|83333.1.peg.4";
2159    
2160    print join("\t",$peg,scalar $fig->feature_location($peg),scalar $fig->function_of($peg)),"\n",
2161          $fig->dna_seq($genome,$fig->feature_location($peg)),"\n",
2162          $fig->get_translation($peg),"\n";
2163    
2164    foreach $fid ($fig->all_features($genome,'rna'))
2165    {
2166        print join("\t",$fid,scalar $fig->feature_location($fid),scalar $fig->function_of($fid)),"\n";
2167    }
2168    
2169    ###############################################
2170    
2171    ### accessing similarities
2172    
2173    use FIGO;
2174    my $figO = new FIGO;
2175    
2176    $peg  = "fig|83333.1.peg.4";
2177    $pegO = new FeatureO($figO,$peg);
2178    
2179    @sims = $pegO->sims;  # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
2180                          # sims (including non-FIG sequences
2181    foreach $sim (@sims)
2182    {
2183        $peg2  = $sim->id2;
2184        $pegO2 = new FeatureO($figO,$peg2);
2185        $func  = $pegO2->function_of;
2186        $sc    = $sim->psc;
2187        print join("\t",($peg2,$sc,$func)),"\n";
2188    }
2189    
2190    #---------------------------------------------
2191    
2192    
2193    use FIG;
2194    my $fig = new FIG;
2195    
2196    $peg  = "fig|83333.1.peg.4";
2197    
2198    @sims = $fig->sims($peg,1000,1.0e-5,"fig");
2199    foreach $sim (@sims)
2200    {
2201        $peg2  = $sim->id2;
2202        $func  = $fig->function_of($peg2);
2203        $sc    = $sim->psc;
2204        print join("\t",($peg2,$sc,$func)),"\n";
2205    }
2206    
2207    ###############################################
2208    
2209    ### accessing BBHs
2210    
2211    use FIGO;
2212    my $figO = new FIGO;
2213    
2214    $peg  = "fig|83333.1.peg.4";
2215    $pegO = new FeatureO($figO,$peg);
2216    
2217    @bbhs = $pegO->bbhs;
2218    foreach $bbh (@bbhs)
2219    {
2220        $peg2  = $bbh->peg2;
2221        $pegO2 = new FeatureO($figO,$peg2);
2222        $func  = $pegO2->function_of;
2223        $sc    = $bbh->psc;
2224        print join("\t",($peg2,$sc,$func)),"\n";
2225    }
2226    
2227    #---------------------------------------------
2228    
2229    use FIG;
2230    my $fig = new FIG;
2231    
2232    $peg  = "fig|83333.1.peg.4";
2233    
2234    @bbhs = $fig->bbhs($peg);
2235    foreach $bbh (@bbhs)
2236    {
2237        ($peg2,$sc,$bit_score) = @$bbh;
2238        $func  = $fig->function_of($peg2);
2239        print join("\t",($peg2,$sc,$func)),"\n";
2240    }
2241    
2242    ###############################################
2243    
2244    ### accessing annotations
2245    
2246    use FIGO;
2247    my $figO = new FIGO;
2248    
2249    $peg  = "fig|83333.1.peg.4";
2250    $pegO = new FeatureO($figO,$peg);
2251    
2252    @annotations = $pegO->annotations;
2253    
2254    foreach $ann (@annotations)
2255    {
2256        print join("\n",$ann->fid,$ann->timestamp(1),$ann->made_by,$ann->text),"\n\n";
2257    }
2258    
2259    #---------------------------------------------
2260    
2261    use FIG;
2262    my $fig = new FIG;
2263    
2264    $peg = "fig|83333.1.peg.4";
2265    @annotations = $fig->feature_annotations($peg);
2266    foreach $_ (@annotations)
2267    {
2268        (undef,$ts,$who,$text) = @$_;
2269        $who =~ s/master://i;
2270        print "$ts\n$who\n$text\n\n";
2271    }
2272    
2273    ###############################################
2274    
2275    ### accessing coupling data
2276    
2277    
2278    use FIGO;
2279    my $figO = new FIGO;
2280    
2281    my $peg  = "fig|83333.1.peg.4";
2282    my $pegO = new FeatureO($figO,$peg);
2283    foreach $coupled ($pegO->coupled_to)
2284    {
2285        print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
2286        foreach $tuple ($coupled->evidence)
2287        {
2288            my($peg3O,$peg4O,$rep) = @$tuple;
2289            print "\t",join("\t",($peg3O->id,$peg4O->id,$rep)),"\n";
2290        }
2291        print "\n";
2292    }
2293    
2294    #---------------------------------------------
2295    
2296    
2297    use FIG;
2298    my $fig = new FIG;
2299    
2300    my $peg1  = "fig|83333.1.peg.4";
2301    foreach $coupled ($fig->coupled_to($peg1))
2302    {
2303        ($peg2,$sc) = @$coupled;
2304        print join("\t",($peg1,$peg2,$sc)),"\n";
2305        foreach $tuple ($fig->coupling_evidence($peg1,$peg2))
2306        {
2307            my($peg3,$peg4,$rep) = @$tuple;
2308            print "\t",join("\t",($peg3,$peg4,$rep)),"\n";
2309        }
2310        print "\n";
2311    }
2312    
2313    ###############################################
2314    
2315    =head3 Accessing Subsystem data
2316    
2317    use FIGO;
2318    my $figO = new FIGO;
2319    
2320    foreach $sub ($figO->subsystems)
2321    {
2322        if ($sub->usable)
2323        {
2324            print join("\t",($sub->id,$sub->curator)),"\n";
2325    
2326            print "\tRoles\n";
2327            @roles = $sub->roles;
2328            foreach $role (@roles)
2329            {
2330                print "\t\t",join("\t",($role->id)),"\n";
2331            }
2332    
2333            print "\tGenomes\n";
2334            foreach $genome ($sub->genomes)
2335            {
2336                print "\t\t",join("\t",($sub->variant($genome),
2337                                        $genome->id,
2338                                        $genome->genus_species)),"\n";
2339                @pegs = ();
2340                foreach $role (@roles)
2341                {
2342                    push(@pegs,$sub->pegs_in_cell($genome,$role));
2343                }
2344                print "\t\t\t",join(",",@pegs),"\n";
2345            }
2346        }
2347    }
2348    
2349    #---------------------------------------------
2350    
2351    use FIG;
2352    my $fig = new FIG;
2353    
2354    foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
2355    {
2356        $subO = new Subsystem($sub,$fig);
2357        $curator = $subO->get_curator;
2358        print join("\t",($sub,$curator)),"\n";
2359    
2360        print "\tRoles\n";
2361        @roles = $subO->get_roles;
2362        foreach $role (@roles)
2363        {
2364            print "\t\t",join("\t",($role)),"\n";
2365        }
2366    
2367        print "\tGenomes\n";
2368        foreach $genome ($subO->get_genomes)
2369        {
2370            print "\t\t",join("\t",($subO->get_variant_code_for_genome($genome),
2371                                    $genome,
2372                                    $fig->genus_species($genome))),"\n";
2373            foreach $role (@roles)
2374            {
2375                push(@pegs,$subO->get_pegs_from_cell($genome,$role));
2376            }
2377            print "\t\t\t",join(",",@pegs),"\n";
2378        }
2379        print "\n";
2380    }
2381    
2382    ###############################################
2383    
2384    =head3 Accessing FIGfams
2385    
2386    use FIGO;
2387    my $figO = new FIGO;
2388    
2389    foreach $fam ($figO->all_figfams)
2390    {
2391        print join("\t",($fam->id,$fam->function)),"\n";
2392        foreach $pegO ($fam->members)
2393        {
2394            $peg = $pegO->id;
2395            print "\t$peg\n";
2396        }
2397    }
2398    
2399    #---------------------------------------------
2400    
2401    use FIG;
2402    use FigFam;
2403    use FigFams;
2404    
2405    my $fig = new FIG;
2406    my $figfams = new FigFams($fig);
2407    
2408    foreach $fam ($figfams->all_families)
2409    {
2410        my $figfam = new FigFam($fig,$fam);
2411        print join("\t",($fam,$figfam->family_function)),"\n";
2412        foreach $peg ($figfam->list_members)
2413        {
2414            print "\t$peg\n";
2415        }
2416    }
2417    
2418    ###############################################
2419    
2420    =head3 Placing a sequence into a FIGfam
2421    
2422    use FIGO;
2423    my $figO = new FIGO;
2424    
2425    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2426    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2427    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2428    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2429    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2430    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2431    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2432    RKLMMNHQ";
2433    $seq =~ s/\n//gs;
2434    
2435    my($fam,$sims) = $figO->family_containing($seq);
2436    
2437    if ($fam)
2438    {
2439        print join("\t",($fam->id,$fam->function)),"\n";
2440        print &Dumper($sims);
2441    }
2442    else
2443    {
2444        print "Could not place it in a family\n";
2445    }
2446    
2447    #---------------------------------------------
2448    
2449    use FIG;
2450    use FigFam;
2451    use FigFams;
2452    
2453    my $fig = new FIG;
2454    my $figfams = new FigFams($fig);
2455    
2456    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2457    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2458    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2459    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2460    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2461    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2462    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2463    RKLMMNHQ";
2464    $seq =~ s/\n//gs;
2465    
2466    my($fam,$sims) = $figfams->place_in_family($seq);
2467    
2468    if ($fam)
2469    {
2470        print join("\t",($fam->family_id,$fam->family_function)),"\n";
2471        print &Dumper($sims);
2472    }
2473    else
2474    {
2475        print "Could not place it in a family\n";
2476    }
2477    
2478    ###############################################
2479    
2480    =head3 Getting representative sequences for a FIGfam
2481    
2482    use FIGO;
2483    my $figO = new FIGO;
2484    
2485    $fam         = "FIG102446";
2486    my $famO     = &FigFamO::new('FigFamO',$figO,$fam);
2487    my @rep_seqs = $famO->rep_seqs;
2488    
2489    foreach $seq (@rep_seqs)
2490    {
2491        print ">query\n$seq\n";
2492    }
2493    
2494    #---------------------------------------------
2495    
2496    use FIG;
2497    use FigFam;
2498    use FigFams;
2499    
2500    my $fig = new FIG;
2501    
2502    $fam         = "FIG102446";
2503    my $famO     = new FigFam($fig,$fam);
2504    my @rep_seqs = $famO->representatives;
2505    
2506    foreach $seq (@rep_seqs)
2507    {
2508        print ">query\n$seq\n";
2509    }
2510    
2511    
2512    ###############################################
2513    
2514    
2515    =head3 Testing for membership in FIGfam
2516    
2517    use FIGO;
2518    my $figO = new FIGO;
2519    
2520    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2521    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2522    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2523    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2524    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2525    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2526    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2527    RKLMMNHQ";
2528    $seq =~ s/\n//gs;
2529    
2530    $fam                  = "FIG102446";
2531    my $famO              = &FigFamO::new('FigFamO',$figO,$fam);
2532    my($should_be, $sims) = $famO->should_be_member($seq);
2533    
2534    if ($should_be)
2535    {
2536        print join("\t",($famO->id,$famO->function)),"\n";
2537        print &Dumper($sims);
2538    }
2539    else
2540    {
2541        print "Sequence should not be added to family\n";
2542    }
2543    
2544    #---------------------------------------------
2545    
2546    use FIG;
2547    use FigFam;
2548    use FigFams;
2549    
2550    my $fig = new FIG;
2551    
2552    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2553    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2554    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2555    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2556    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2557    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2558    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2559    RKLMMNHQ";
2560    $seq =~ s/\n//gs;
2561    
2562    $fam                  = "FIG102446";
2563    my $famO              = new FigFam($fig,$fam);
2564    my($should_be, $sims) = $famO->should_be_member($seq);
2565    
2566    if ($should_be)
2567    {
2568        print join("\t",($famO->family_id,$famO->family_function)),"\n";
2569        print &Dumper($sims);
2570    }
2571    else
2572    {
2573        print "Sequence should not be added to family\n";
2574    }
2575    
2576    =cut
2577    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3