[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.6, Thu Feb 22 13:43:18 2007 UTC revision 1.33, Tue May 6 16:45:37 2008 UTC
# Line 1  Line 1 
1    # -*- perl -*-
2    ########################################################################
3  #  #
4  # Copyright (c) 2003-2006 University of Chicago and Fellowship  # Copyright (c) 2003-2006 University of Chicago and Fellowship
5  # for Interpretations of Genomes. All Rights Reserved.  # for Interpretations of Genomes. All Rights Reserved.
# Line 14  Line 16 
16  # Genomes at veronika@thefig.info or download a copy from  # Genomes at veronika@thefig.info or download a copy from
17  # http://www.theseed.org/LICENSE.TXT.  # http://www.theseed.org/LICENSE.TXT.
18  #  #
19    ########################################################################
20    
21  package FIGO;  =head1 TODO
22    
23    =over 4
24    
25    =item Null arg to ContigO::dna_seq() should return entire contig seq.
26    
27    =item Add method to access "FIG::crude_estimate_of_distance()"
28    
29    =back
30    
31    =cut
32    
33    =head1 Overview
34    
35    This module is a set of packages encapsulating the SEED's core methods
36    using an "OOP-like" style.
37    
38    There are several modules clearly related to "individual genomes:"
39    GenomeO, ContigO, FeatureO (and I<maybe> AnnotationO).
40    
41    There are also modules that deal with complex relationships between
42    pairs or sets of features in one, two, or more genomes,
43    rather than any particular single genome:
44    BBHO, CouplingO, SubsystemO, FunctionalRoleO, FigFamO.
45    
46    Finally, the methods in "Attribute" might in principle attach
47    "atributes" to any type of object.
48    (Likewise, in principle one might also want to attach an "annotation"
49    to any type of object,
50    although currently we only support annotations of "features.")
51    
52    The three modules that act on "individual genomes" have a reasonable clear
53    "implied heirarchy" relative to FIGO:
54    
55    =over 4
56    
57        FIGO > GenomeO > ContigO > FeatureO
58    
59    =back
60    
61    However, inheritance is B<NOT> implemented using the C<@ISA> mechanism,
62    because some methods deal with "pairwise" or "setwise" relations between objects
63    or other more complex relationships that do not naturally fit into any heirarchy ---
64    which would get us into the whole quagmire of "multiple inheritance."
65    
66    We have chosen to in many cases sidestep the entire issue of inheritance
67    via an I<ad hoc> mechanism:
68    If a "child" object needs access to its "ancestors'" methods,
69    we will explicitly pass it references to its "ancestors,"
70    as subroutine arguments.
71    This is admittedly ugly, clumsy, and potentially error-prone ---
72    but it has the advantage that, unlike multiple inheritance,
73    we understand how to do it...
74    
75    MODULE DEPENDENCIES: FIG, FIG_Config, FigFams, SFXlate, SproutFIG, Tracer,
76        gjoparseblast, Data::Dumper.
77    
78    =cut
79    
80    ########################################################################
81    package FIGO;
82    ########################################################################
83  use strict;  use strict;
84  use FIG;  use FIG;
85    use FIGV;
86  use FIG_Config;  use FIG_Config;
87  use SFXlate;  use SFXlate;
88  use SproutFIG;  use SproutFIG;
89  use Tracer;  use Tracer;
90  use Data::Dumper;  use Data::Dumper;
91    use Carp;
92  use FigFams;  use FigFams;
93  use gjoparseblast;  use gjoparseblast;
94    
95  =head1 FIGO Methods  =head1 FIGO
96    
97    The effective "base class" containing a few "top-level" methods.
98    
99    =cut
100    
101    
102  =head3 new  =head3 new
103    
# Line 37  Line 107 
107    
108  =item USAGE:  =item USAGE:
109    
110  C<< my $figo = FIGO->new();           #...Subclass defaults to FIG >>      my $figO = FIGO->new();                    #...Subclass defaults to FIG
111    
112        my $figO = FIGO->new('SPROUT');            #...Subclass is a SPROUT object
113    
114        my $figO = FIGO->new($orgdir);             #...Subclass includes $orgdir as a "Virtual" SEED genome
115    
116  C<< my $figo = FIGO->new('SPROUT');   #...Subclass is a SPROUT object >>      my $figO = FIGO->new($orgdir, 'SPROUT');   #...Subclass includes $orgdir as a "Virtual" SPROUT genome
117    
118  =back  =back
119    
120  =cut  =cut
121    
122  sub new {  sub new {
123      my($class,$low_level) = @_;      my ($class, @argv) = @_;
124    
125      my $fig;      my $fig;
126      if ($low_level && ($low_level =~ /sprout/i))      if (@argv) {
127      {          if (-d $argv[0]) {
128          $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);              print STDERR ("FIGO using FIGV, argv = ( ",
129                              join(qq(, ), @argv),
130                              " )\n",
131                              ) if $ENV{FIG_DEBUG};
132    
133                $fig = FIGV->new(@argv);
134            }
135            else {
136    
137                if ($argv[0] =~ /sprout/io) {
138                    print STDERR "FIGO using SPROUT\n";
139                    $fig = SproutFIG->new($FIG_Config::sproutDB, $FIG_Config::sproutData);
140                }
141      }      }
142      else      }
143      {      else {
144          $fig = new FIG;          print STDERR "FIGO using FIG with installed orgs\n";
145            $fig = FIG->new();
146      }      }
147    
148      my $self = {};      my $self = {};
# Line 64  Line 151 
151      return bless $self, $class;      return bless $self, $class;
152  }  }
153    
154    sub function_of {
155        my($self,$id) = @_;
156    
157        my $fig  = $self->{_fig};
158        my $func = $fig->function_of($id);
159    
160        return ($func ? $func : "");
161    }
162    
163  =head3 genomes  =head3 genomes
164    
# Line 75  Line 169 
169    
170  =item USAGE:  =item USAGE:
171    
172  C<< my @tax_ids = $figo->genomes(); >>      my @tax_ids = $figo->genomes();
173    
174  C<< my @tax_ids = $figo->genomes( @constraints ); >>      my @tax_ids = $figo->genomes( @constraints );
175    
176  =item @constraints  =item @constraints
177    
178  One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.  One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
179    
180  =item RETURNS: List of Tax-IDs.  =item RETURNS: List of Tax-IDs.
181    
182  =item EXAMPLE: L<Display all complete, prokaryotic genomes>  =item EXAMPLE:
183    
184    L<Display all complete, prokaryotic genomes>
185    
186  =back  =back
187    
# Line 141  Line 238 
238  =over4  =over4
239    
240  =item RETURNS:  =item RETURNS:
241    
242  List of all subsystems.  List of all subsystems.
243    
244  =item EXAMPLE: L<Accessing Subsystem data>  =item EXAMPLE:
245    
246    L<Accessing Subsystem data>
247    
248  =back  =back
249    
# Line 188  Line 288 
288    
289  =over4  =over4
290    
291  =item USAGE:  C<< foreach $fam ($figO->all_figfams) { #...Do something } >>  =item USAGE:
292    
293  =item RETURNS: List of FIGfam Objects      foreach $fam ($figO->all_figfams) { #...Do something }
294    
295  =item EXAMPLE: L<Accessing FIGfams>  =item RETURNS:
296    
297    List of FIGfam Objects
298    
299    =item EXAMPLE:
300    
301    L<Accessing FIGfams>
302    
303  =back  =back
304    
# Line 201  Line 307 
307  sub all_figfams {  sub all_figfams {
308      my($self) = @_;      my($self) = @_;
309      my $fig = $self->{_fig};      my $fig = $self->{_fig};
310      my $fams = new FigFams($fig);      my $fams = FigFams->new($fig);
311      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
312  }  }
313    
# Line 211  Line 317 
317    
318  =over4  =over4
319    
320  =item USAGE:   C<< my ($fam, $sims) = $figO->family_containing($seq); >>  =item USAGE:
321    
322        my ($fam, $sims) = $figO->family_containing($seq);
323    
324    =item $seq:
325    
326  =item $seq:    A protein translation string.  A protein translation string.
327    
328  =item RETURNS:  =item RETURNS:
329    
330        $fam:  A FIGfam Object.        $fam:  A FIGfam Object.
331    
332        $sims: A set of similarity objects.        $sims: A set of similarity objects.
333    
334  =item EXAMPLE: L<Placing a sequence into a FIGfam>  =item EXAMPLE: L<Placing a sequence into a FIGfam>
# Line 229  Line 341 
341      my($self,$seq) = @_;      my($self,$seq) = @_;
342    
343      my $fig = $self->{_fig};      my $fig = $self->{_fig};
344      my $fams = new FigFams($fig);      my $fams = FigFams->new($fig);
345      my($fam,$sims) = $fams->place_in_family($seq);      my($fam,$sims) = $fams->place_in_family($seq);
346      if ($fam)      if ($fam)
347      {      {
# Line 241  Line 353 
353      }      }
354  }  }
355    
356    =head3 figfam
357    
358    =over 4
359    
360    =item USAGE:
361    
362        my $fam = $figO->figfam($family_id);
363    
364    =item $family_id;
365    
366    A FigFam ID
367    
368    =item RETURNS:
369    
370    $fam:  A FIGfam Object.
371    
372    =back
373    
374    =cut
375    
376    sub figfam {
377        my($self,$fam_id) = @_;
378    
379        return &FigFamO::new('FigFamO',$self,$fam_id);
380    }
381    
382    
383  ########################################################################  ########################################################################
384  package GenomeO;  package GenomeO;
# Line 251  Line 389 
389    
390  =cut  =cut
391    
392    
393  =head3 new  =head3 new
394    
395  Constructor of GenomeO objects.  Constructor of GenomeO objects.
# Line 258  Line 397 
397  =over4  =over4
398    
399  =item USAGE:  =item USAGE:
 C<< my $org = GenomeO->new($figo, $tax_id); >>  
400    
401  =item RETURNS: A new GenomeO object.      my $orgO = GenomeO->new($figO, $tax_id);
402    
403    =item RETURNS:
404    
405    A new "GenomeO" object.
406    
407  =back  =back
408    
# Line 281  Line 423 
423    
424  =over4  =over4
425    
426  =item USAGE:   C<< my $tax_id = $org->id(); >>  =item USAGE:
427    
428  =item RETURNS: Taxonomy-ID of GenomeO object.      my $tax_id = $orgO->id();
429    
430    =item RETURNS:
431    
432    Taxonomy-ID of "GenomeO" object.
433    
434  =back  =back
435    
# Line 301  Line 447 
447    
448  =over4  =over4
449    
450  =item USAGE:   C<< $gs = $genome->genus_species(); >>  =item USAGE:
451    
452        $gs = $orgO->genus_species();
453    
454    =item RETURNS:
455    
456  =item RETURNS: Genus-species-strain string  Genus-species-strain string
457    
458  =back  =back
459    
# Line 317  Line 467 
467  }  }
468    
469    
470    
471    
472    =head3 taxonomy_of
473    
474    =over 4
475    
476    =item FUNCTION:
477    
478    Return the TAXONOMY string of a "GenomeO" object.
479    
480    =item USAGE:
481    
482        my $taxonomy = $orgO->taxonomy_of();
483    
484    =item RETURNS:
485    
486    TAXONOMY string.
487    
488    =back
489    
490    =cut
491    
492    sub taxonomy_of {
493        my ($self) = @_;
494    
495        my $figO = $self->{_figO};
496        my $fig  = $figO->{_fig};
497    
498        return $fig->taxonomy_of($self->{_id});
499    }
500    
501    
502  =head3 contigs_of  =head3 contigs_of
503    
504  =over4  =over4
505    
506  =item RETURNS: List of C<contig> objects contained in a C<GenomeO> object.  =item RETURNS:
507    
508  =item EXAMPLE: L<Show how to access contigs and extract sequence>  List of C<contig> objects contained in a C<GenomeO> object.
509    
510    =item EXAMPLE:
511    
512    L<Show how to access contigs and extract sequence>
513    
514  =back  =back
515    
# Line 341  Line 527 
527    
528  =head3 features_of  =head3 features_of
529    
530    =over 4
531    
532    =item FUNCTION:
533    
534    Returns a list of "FeatureO" objects contained in a "GenomeO" object.
535    
536    =item USAGE:
537    
538        my @featureOs = $orgO->features_of();        #...Fetch all features
539    
540    or
541    
542        my @featureOs = $orgO->features_of('peg');   #...Fetch only PEGs
543    
544    =item RETURNS:
545    
546    List of "FeatureO" objects.
547    
548    =back
549    
550  =cut  =cut
551    
552  sub features_of {  sub features_of {
# Line 359  Line 565 
565    
566  =over4  =over4
567    
568  =item USAGE:   C<< $genome->display(); >>  =item USAGE:
569    
570        $genome->display();
571    
572    =item RETURNS:
573    
574  =item RETURNS: Null  (Void)
575    
576  =back  =back
577    
# Line 393  Line 603 
603  =over4  =over4
604    
605  =item USAGE:  =item USAGE:
 C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>  
606    
607  =item $figO: A FIGO object.      $contig = ContigO->new( $figO, $genomeId, $contigId);
608    
609    =item $figO:
610    
611    Parent FIGO object.
612    
613    =item $genomeId:
614    
615  =item $genomeId: Taxon-ID for the genome the contig is from.  Taxon-ID for the genome the contig is from.
616    
617  =item $contigId: Identifier for the contig  =item $contigId:
618    
619    Identifier for the contig
620    
621    =item RETURNS:
622    
623  =item RETURNS: A "ContigO" object.  A "ContigO" object.
624    
625  =back  =back
626    
# Line 423  Line 642 
642    
643  =over4  =over4
644    
645  =item RETURNS: Sequence ID string of "ContigO" object  =item RETURNS:
646    
647    Sequence ID string of "ContigO" object
648    
649  =back  =back
650    
# Line 441  Line 662 
662  =over4  =over4
663    
664  =item USAGE:  =item USAGE:
     C<< my $tax_id = $contig->genome(); >>  
665    
666  =item RETURNS: GenomeO object containing the contig object.      my $tax_id = $contig->genome->id();
667    
668    =item RETURNS:
669    
670    Tax-ID of the GenomeO object containing the contig object.
671    
672  =back  =back
673    
# Line 452  Line 676 
676  sub genome {  sub genome {
677      my($self) = @_;      my($self) = @_;
678    
679      return $self->{_genome};      my $figO = $self->{_figO};
680        return GenomeO->new($figO,$self->{_genome});
681  }  }
682    
683    
# Line 462  Line 687 
687  =over4  =over4
688    
689  =item USAGE:  =item USAGE:
     C<< my $len = $contig->contig_length(); >>  
690    
691  =item RETURNS: Length of contig's DNA sequence.      my $len = $contig->contig_length();
692    
693    =item RETURNS:
694    
695    Length of contig's DNA sequence.
696    
697  =back  =back
698    
# Line 474  Line 702 
702      my($self) = @_;      my($self) = @_;
703    
704      my $fig = $self->{_figO}->{_fig};      my $fig = $self->{_figO}->{_fig};
705      my $contig_lengths = $fig->contig_lengths($self->genome);      my $contig_lengths = $fig->contig_lengths($self->genome->id);
706      return $contig_lengths->{$self->id};      return $contig_lengths->{$self->id};
707  }  }
708    
# Line 484  Line 712 
712  =over4  =over4
713    
714  =item USAGE:  =item USAGE:
     C<< my $seq = $contig->dna_seq(beg, $end); >>  
715    
716  =item $beg: Begining point of DNA subsequence      my $seq = $contig->dna_seq(beg, $end);
717    
718    =item $beg:
719    
720  =item $end: End point of DNA subsequence  Begining point of DNA subsequence
721    
722  =item RETURNS: string of DNA sequence from $beg to $end  =item $end:
723    
724    End point of DNA subsequence
725    
726    =item RETURNS:
727    
728    String containing DNA subsequence running from $beg to $end
729  (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)  (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
730    
731  =back  =back
# Line 506  Line 740 
740      if (($beg && (&FIG::between(1,$beg,$max))) &&      if (($beg && (&FIG::between(1,$beg,$max))) &&
741          ($end && (&FIG::between(1,$end,$max))))          ($end && (&FIG::between(1,$end,$max))))
742      {      {
743          return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));          return $fig->dna_seq($self->genome->id,join("_",($self->id,$beg,$end)));
744      }      }
745      else      else
746      {      {
# Line 527  Line 761 
761    
762  =over4  =over4
763    
764  =item RETURNS: Nil  =item RETURNS:
765    
766    (Void)
767    
768  =back  =back
769    
# Line 536  Line 772 
772  sub display {  sub display {
773      my($self) = @_;      my($self) = @_;
774    
775      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";      print join("ContigO",$self->genome->id,$self->id,$self->contig_length),"\n";
776    }
777    
778    sub features_in_region {
779        my($self,$beg,$end) = @_;
780        my $figO = $self->{_figO};
781        my $fig = $figO->{_fig};
782    
783        my($features) = $fig->genes_in_region($self->genome->id,$self->id,$beg,$end);
784        return map { FeatureO->new($figO,$_) } @$features;
785  }  }
786    
787    
# Line 545  Line 790 
790  package FeatureO;  package FeatureO;
791  ########################################################################  ########################################################################
792  use Data::Dumper;  use Data::Dumper;
793    use Carp;
794    
795  =head1 FeatureO  =head1 FeatureO
796    
797    Methods for working with features on "ContigO" objects.
798    
799  =cut  =cut
800    
801    
802    =head3 new
803    
804    Constructor of new "FeatureO" objects
805    
806  =head1 new  =over 4
807    
808    =item USAGE:
809    
810  Constructor of "FeatureO" objects      my $feature = FeatureO->new( $figO, $fid );
811    
812    =item C<$figO>:
813    
814    "Base" FIGO object.
815    
816    =item C<$fid>:
817    
818    Feature-ID for new feature
819    
820    =item RETURNS:
821    
822    A newly created "FeatureO" object.
823    
824    =back
825    
826  =cut  =cut
827    
# Line 569  Line 836 
836  }  }
837    
838    
839    
840  =head3 id  =head3 id
841    
842    =over 4
843    
844    =item USAGE:
845    
846        my $fid = $feature->id();
847    
848    =item RETURNS:
849    
850    The FID (Feature ID) of a "FeatureO" object.
851    
852    =back
853    
854  =cut  =cut
855    
856  sub id {  sub id {
# Line 583  Line 863 
863    
864  =head3 genome  =head3 genome
865    
866    =over 4
867    
868    =item USAGE:
869    
870        my $taxid = $feature->genome();
871    
872    =item RETURNS:
873    
874    The Taxon-ID for the "GenomeO" object containing the feature.
875    
876    =back
877    
878  =cut  =cut
879    
880  sub genome {  sub genome {
881      my($self) = @_;      my($self) = @_;
882        my $figO = $self->{_figO};
883      $self->id =~ /^fig\|(\d+\.\d+)/;      $self->id =~ /^fig\|(\d+\.\d+)/;
884      return $1;      return GenomeO->new($figO,$1);
885  }  }
886    
887    
888    
889  =head3 type  =head3 type
890    
891    =over 4
892    
893    =item USAGE:
894    
895        my $feature_type = $feature->type();
896    
897    =item RETURNS:
898    
899    The feature object's "type" (e.g., "peg," "rna," etc.)
900    
901    =back
902    
903  =cut  =cut
904    
905  sub type {  sub type {
# Line 607  Line 911 
911    
912    
913    
   
914  =head3 location  =head3 location
915    
916    =over 4
917    
918    =item USAGE:
919    
920        my $loc = $feature->location();
921    
922    =item RETURNS:
923    
924    A string representing the feature object's location on the genome's DNA,
925    in SEED "tbl format" (i.e., "contig_beging_end").
926    
927    =back
928    
929  =cut  =cut
930    
931  sub location {  sub location {
# Line 620  Line 936 
936  }  }
937    
938    
939    =head3 contig
940    
941    =over 4
942    
943    =item USAGE:
944    
945        my $contig = $feature->contig();
946    
947    =item RETURNS:
948    
949    A "ContigO" object to access the contig data
950    for the contig the feature is on.
951    
952    =back
953    
954    =cut
955    
956    sub contig {
957        my($self) = @_;
958    
959        my $figO = $self->{_figO};
960        my $loc      = $self->location;
961        my $genomeID = $self->genome->id;
962        return (($loc =~ /^(\S+)_\d+_\d+$/) ? ContigO->new($figO,$genomeID,$1) : undef);
963    }
964    
965    
966    
967    =head3 begin
968    
969    =over 4
970    
971    =item USAGE:
972    
973        my $beg = $feature->begin();
974    
975    =item RETURNS:
976    
977    The numerical coordinate of the first base of the feature.
978    
979    =back
980    
981    =cut
982    
983    sub begin {
984        my($self) = @_;
985    
986        my $loc = $self->location;
987        return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
988    }
989    
990    
991    
992    =head3 end
993    
994    =over 4
995    
996    =item USAGE:
997    
998        my $end = $feature->end();
999    
1000    =item RETURNS:
1001    
1002    The numerical coordinate of the last base of the feature.
1003    
1004    =back
1005    
1006    =cut
1007    
1008    sub end {
1009        my($self) = @_;
1010    
1011        my $loc = $self->location;
1012        return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
1013    }
1014    
1015    
1016    
1017  =head3 dna_seq  =head3 dna_seq
1018    
1019    =over 4
1020    
1021    =item USAGE:
1022    
1023        my $dna_seq = $feature->dna_seq();
1024    
1025    =item RETURNS:
1026    
1027    A string contining the DNA subsequence of the contig
1028    running from the first to the last base of the feature.
1029    
1030    If ($beg > $end), the reverse complement subsequence is returned.
1031    
1032    =back
1033    
1034  =cut  =cut
1035    
1036  sub dna_seq {  sub dna_seq {
# Line 638  Line 1046 
1046    
1047  =head3 prot_seq  =head3 prot_seq
1048    
1049    =over 4
1050    
1051    =item USAGE:
1052    
1053        my $dna_seq = $feature->prot_seq();
1054    
1055    =item RETURNS:
1056    
1057    A string contining the protein translation of the feature (if it exists),
1058    or the "undef" value if the feature does not exist or is not a PEG.
1059    
1060    =back
1061    
1062  =cut  =cut
1063    
1064  sub prot_seq {  sub prot_seq {
# Line 653  Line 1074 
1074    
1075  =head3 function_of  =head3 function_of
1076    
1077    =over 4
1078    
1079    =item USAGE:
1080    
1081        my $func = $feature->function_of();
1082    
1083    =item RETURNS:
1084    
1085    A string containing the function assigned to the feature,
1086    or the "undef" value if no function has been assigned.
1087    
1088    =back
1089    
1090  =cut  =cut
1091    
1092  sub function_of {  sub function_of {
# Line 667  Line 1101 
1101    
1102  =head3 coupled_to  =head3 coupled_to
1103    
1104    =over 4
1105    
1106    =item USAGE:
1107    
1108        my @coupled_features = $feature->coupled_to();
1109    
1110    =item RETURNS:
1111    
1112    A list of "CouplingO" objects describing the evidence for functional coupling
1113    between this feature and other nearby features.
1114    
1115    =back
1116    
1117  =cut  =cut
1118    
1119  sub coupled_to {  sub coupled_to {
1120      my($self) = @_;      my($self) = @_;
1121    
1122      ($self->type eq "peg") || return undef;      ($self->type eq "peg") || return ();
1123      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1124      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1125      my $peg1 = $self->id;      my $peg1 = $self->id;
# Line 689  Line 1136 
1136    
1137  =head3 annotations  =head3 annotations
1138    
1139    =over 4
1140    
1141    =item USAGE:
1142    
1143        my @annot_list = $feature->annotations();
1144    
1145    =item RETURNS:
1146    
1147    A list of "AnnotationO" objects allowing access to the annotations for this feature.
1148    
1149    =back
1150    
1151  =cut  =cut
1152    
1153  sub annotations {  sub annotations {
# Line 700  Line 1159 
1159      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
1160  }  }
1161    
1162    
1163    =head3 in_subsystems
1164    
1165    =over 4
1166    
1167    =item USAGE:
1168    
1169        my @subsys_list = $feature->in_subsystems();
1170    
1171    =item RETURNS:
1172    
1173    A list of "SubsystemO" objects allowing access to the subsystems
1174    that this feature particupates in.
1175    
1176    =back
1177    
1178    =cut
1179    
1180  sub in_subsystems {  sub in_subsystems {
1181      my($self) = @_;      my($self) = @_;
1182      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1183      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1184    
1185      return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);      return map { SubsystemO->new($figO,$_) } $fig->peg_to_subsystems($self->id);
1186  }  }
1187    
1188    
1189  =head3 possibly_truncated  =head3 possibly_truncated
1190    
1191    =over 4
1192    
1193    =item USAGE:
1194    
1195        my $trunc = $feature->possibly_truncated();
1196    
1197    =item RETURNS:
1198    
1199    Boolean C<TRUE> if the feature may be truncated;
1200    boolean C<FALSE> otherwise.
1201    
1202    =back
1203    
1204  =cut  =cut
1205    
1206  sub possibly_truncated {  sub possibly_truncated {
# Line 725  Line 1215 
1215    
1216  =head3 possible_frameshift  =head3 possible_frameshift
1217    
1218    =over 4
1219    
1220    =item USAGE:
1221    
1222        my $fs = $feature->possible_frameshift();
1223    
1224    =item RETURNS:
1225    
1226    Boolean C<TRUE> if the feature may be a frameshifted fragment;
1227    boolean C<FALSE> otherwise.
1228    
1229    (NOTE: This is a crude prototype implementation,
1230    and is mostly as an example of how to code using FIGO.)
1231    
1232    =back
1233    
1234  =cut  =cut
1235    
1236  sub possible_frameshift {  sub possible_frameshift {
1237      my($self) = @_;      my($self) = @_;
1238      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1239      my($tmp_dir) = $figO->{_tmp_dir};      my $fig = $figO->{_fig};
1240    
1241      if (! $self->possibly_truncated)      return $fig->possible_frameshift($self->id);
     {  
         my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);  
         if (my $sim = shift @sims)  
         {  
             my $peg2 = $sim->id2;  
             my $ln1  = $sim->ln1;  
             my $ln2  = $sim->ln2;  
             my $b2   = $sim->b2;  
             my $e2   = $sim->e2;  
             my $adjL = 100 + (($b2-1) * 3);  
             my $adjR = 100 + (($ln2 - $e2) * 3);  
             if ($ln2 > (1.2 * $ln1))  
             {  
                 my $loc = $self->location;  
                 if ($loc =~ /^(\S+)_(\d+)_(\d+)/)  
                 {  
                     my $contig = $1;  
                     my $beg    = $2;  
                     my $end = $3;  
                     my $contigO = new ContigO($figO,$self->genome,$contig);  
                     my $begA = &max(1,$beg - $adjL);  
                     my $endA = &min($end+$adjR,$contigO->contig_length);  
                     my $dna  = $contigO->dna_seq($begA,$endA);  
                     open(TMP,">$tmp_dir/tmp_dna") || die "couild not open tmp_dna";  
                     print TMP ">dna\n$dna\n";  
                     close(TMP);  
   
                     my $peg2O = new FeatureO($figO,$peg2);  
                     my $prot  = $peg2O->prot_seq;  
                     open(TMP,">$tmp_dir/tmp_prot") || die "could not open tmp_prot";  
                     print TMP ">tmp_prot\n$prot\n";  
                     close(TMP);  
                     &run("formatdb -i $tmp_dir/tmp_dna -pF");  
                     open(BLAST,"blastall -i $tmp_dir/tmp_prot -d $tmp_dir/tmp_dna -p tblastn -FF -e 1.0e-50 |")  
                         || die "could not blast";  
   
                     my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);  
                     my @hsps       = sort { $a->[0] <=> $b->[0] }  
                                      map { [$_->[9],$_->[10],$_->[12],$_->[13]] }  
                                      grep { $_->[1] < 1.0e-50 }  
                                      @{$db_seq_out->[6]};  
                     my @prot = map { [$_->[0],$_->[1]] } @hsps;  
                     my @dna  = map { [$_->[2],$_->[3]] } @hsps;  
                     if (&covers(\@prot,length($prot),3) && &covers(\@dna,3*length($prot),9))  
                     {  
                         return 1;  
                     }  
                 }  
             }  
         }  
     }  
     return 0;  
1242  }  }
1243    
1244    
1245    
1246  =head3 run  =head3 run
1247    
1248    (Note: This function should be considered "PRIVATE")
1249    
1250    =over 4
1251    
1252    =item FUNCTION:
1253    
1254    Passes a string containing a command to be execture by the "system" shell command.
1255    
1256    =item USAGE:
1257    
1258        $feature->run($cmd);
1259    
1260    =item RETURNS:
1261    
1262    Nil if the execution of C<$cmd> was successful;
1263    aborts with traceback if C<$cmd> fails.
1264    
1265    =back
1266    
1267  =cut  =cut
1268    
1269  sub run {  sub run {
1270      my($cmd) = @_;      my($cmd) = @_;
1271      (system($cmd) == 0) || Confess("FAILED: $cmd");      (system($cmd) == 0) || confess("FAILED: $cmd");
1272  }  }
1273    
1274    
1275    
1276  =head3 max  =head3 max
1277    
1278    (Note: This function should be considered "PRIVATE")
1279    
1280    =over 4
1281    
1282    =item USAGE:
1283    
1284        my $max = $feature->max($x, $y);
1285    
1286    =item C<$x> and  C<$y>
1287    
1288    Numerical values.
1289    
1290    =item RETURNS:
1291    
1292    The larger of the two numerical values C<$x> and C<$y>.
1293    
1294    =back
1295    
1296  =cut  =cut
1297    
1298  sub max {  sub max {
# Line 813  Line 1304 
1304    
1305  =head3 min  =head3 min
1306    
1307  =cut  (Note: This function should be considered "PRIVATE")
1308    
1309  sub min {  =over 4
     my($x,$y) = @_;  
     return ($x < $y) ? $x : $y;  
 }  
1310    
1311    =item USAGE:
1312    
1313        my $min = $feature->min($x, $y);
1314    
1315  =head3 covers  =item C<$x> and C<$y>
1316    
1317  =cut  Numerical values.
1318    
1319  sub covers {  =item RETURNS:
1320      my($hsps,$ln,$diff) = @_;  
1321    The smaller of the two numerical values C<$x> and C<$y>.
1322    
1323    =back
1324    
1325    =cut
1326    
1327      my $hsp1 = shift @$hsps;  sub min {
1328      my $hsp2;      my($x,$y) = @_;
1329      while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}      return ($x < $y) ? $x : $y;
     return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));  
1330  }  }
1331    
1332    =head3 sims
1333    
1334    =over 4
1335    
1336  =head3 merge  =item FUNCTION:
1337    
1338  =cut  Returns precomputed "Sim.pm" objects from the SEED.
1339    
1340  sub merge {  =item USAGE:
     my($hsp1,$hsp2,$diff) = @_;  
1341    
1342      my($b1,$e1) = @$hsp1;      my @sims = $pegO->sims( -all, -cutoff => 1.0e-10);
     my($b2,$e2) = @$hsp2;  
     return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;  
 }  
1343    
1344        my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10);
1345    
1346    =item RETURNS: List of sim objects.
1347    
1348  =head3 sims  =back
1349    
1350  =cut  =cut
1351    
# Line 863  Line 1357 
1357      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1358    
1359      my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;      my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
1360      my $all    = $args{-all}    ? $args{-all}    : "fig";      my $all    = $args{-all}    ? 'all'          : "fig";
1361      my $max    = $args{-max}    ? $args{-max}    : 10000;      my $max    = $args{-max}    ? $args{-max}    : 10000;
1362    
1363      return $fig->sims($self->id,$max,$cutoff,$all);      my @sims = $fig->sims($self->id,$max,$cutoff,$all);
1364    
1365        if (@sims) {
1366            my $peg1 = FeatureO->new($figO, $sims[0]->[0]);
1367    
1368            foreach my $sim (@sims) {
1369    #           $sim->[0] = $peg1;
1370    #           $sim->[1] = FeatureO->new($figO, $sim->[1]);
1371            }
1372        }
1373    
1374        return @sims;
1375  }  }
1376    
1377    
1378    
1379  =head3 bbhs  =head3 bbhs
1380    
1381    =over 4
1382    
1383    =item FUNCTION:
1384    
1385    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1386    corresponding to the pre-computed BBHs for that PEG.
1387    
1388    =item USAGE:
1389    
1390        my @bbhs = $pegO->bbhs();
1391    
1392    =item RETURNS:
1393    
1394    List of BBHO objects.
1395    
1396    =back
1397    
1398  =cut  =cut
1399    
1400  sub bbhs {  sub bbhs {
# Line 890  Line 1412 
1412                                                  },'BBHO') } @bbhs;                                                  },'BBHO') } @bbhs;
1413  }  }
1414    
1415    
1416  =head3 display  =head3 display
1417    
1418    =over 4
1419    
1420    =item FUNCTION:
1421    
1422    Prints info about a "FeatureO" object to STDOUT.
1423    
1424    =item USAGE:
1425    
1426        $pegO->display();
1427    
1428    =item RETURNS;
1429    
1430    (void)
1431    
1432    =back
1433    
1434  =cut  =cut
1435    
1436  sub display {  sub display {
# Line 910  Line 1449 
1449    
1450  =head1 BBHO  =head1 BBHO
1451    
1452    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1453    
1454  =cut  =cut
1455    
1456    
1457  =head3 new  =head3 new
1458    
1459    Constructor of BBHO objects.
1460    
1461    (NOTE: The "average user" should never need to invoke this method.)
1462    
1463  =cut  =cut
1464    
1465  sub new {  sub new {
# Line 930  Line 1475 
1475  }  }
1476    
1477    
1478    
1479  =head3 peg1  =head3 peg1
1480    
1481    =over 4
1482    
1483    =item USAGE:
1484    
1485        my $peg1 = $bbh->peg1();
1486    
1487    =item RETURNS:
1488    
1489    A "FeatureO" object corresponding to the "query" sequence
1490    in a BBH pair.
1491    
1492    =back
1493    
1494  =cut  =cut
1495    
1496  sub peg1 {  sub peg1 {
1497      my($self) = @_;      my($self) = @_;
1498    
1499      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1500      return new FeatureO($figO,$self->{_peg1});      return FeatureO->new($figO, $self->{_peg1});
1501  }  }
1502    
1503  =head3 peg2  =head3 peg2
1504    
1505    =over 4
1506    
1507    =item USAGE:
1508    
1509        my $peg2 = $bbh->peg2();
1510    
1511    =item RETURNS:
1512    
1513    A "FeatureO" object corresponding to the "database" sequence
1514    in a BBH pair.
1515    
1516    =back
1517    
1518  =cut  =cut
1519    
1520  sub peg2 {  sub peg2 {
1521      my($self) = @_;      my($self) = @_;
1522    
1523      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1524      return new FeatureO($figO,$self->{_peg2});      return FeatureO->new($figO,$self->{_peg2});
1525  }  }
1526    
1527    
1528    
1529  =head3 psc  =head3 psc
1530    
1531    =over 4
1532    
1533    =item USAGE:
1534    
1535        my $psc = $bbh->psc();
1536    
1537    =item RETURNS:
1538    
1539    The numerical value of the BLAST E-value for the pair.
1540    
1541    =back
1542    
1543  =cut  =cut
1544    
1545  sub psc {  sub psc {
# Line 968  Line 1552 
1552    
1553  =head3 norm_bitscore  =head3 norm_bitscore
1554    
1555    
1556    =over 4
1557    
1558    =item USAGE:
1559    
1560        my $bsc = $bbh->norm_bitscore();
1561    
1562    =item RETURNS:
1563    
1564    The "BLAST bit-score per aligned character" for the pair.
1565    
1566    =back
1567    
1568  =cut  =cut
1569    
1570  sub norm_bitscore {  sub norm_bitscore {
# Line 984  Line 1581 
1581    
1582  =head1 AnnotationO  =head1 AnnotationO
1583    
1584    Methods for accessing SEED annotations.
1585    
1586  =cut  =cut
1587    
1588    
1589    
1590  =head3 new  =head3 new
1591    
1592    =over 4
1593    
1594    =item FUNCTION:
1595    
1596    Cronstruct a new "AnnotationO" object
1597    
1598    =item USAGE:
1599    
1600        my $annotO = AnnotationO->new( $fid, $timestamp, $who, $text);
1601    
1602    =item C<$fid>
1603    
1604    A feature identifier.
1605    
1606    =item C<$timestamp>
1607    
1608    The C<UN*X> timestamp one wishes to associate with the annotation.
1609    
1610    =item C<$who>
1611    
1612    The annotator's user-name.
1613    
1614    =item C<$text>
1615    
1616    The textual content of the annotation.
1617    
1618    =item RETURNS:
1619    
1620    An "AnnotationO" object.
1621    
1622    =back
1623    
1624  =cut  =cut
1625    
1626  sub new {  sub new {
# Line 1007  Line 1638 
1638    
1639  =head3 fid  =head3 fid
1640    
1641    =over 4
1642    
1643    =item FUNCTION:
1644    
1645    Extract the feature-ID that was annotated.
1646    
1647    =item USAGE:
1648    
1649        my $fid = $annotO->fid();
1650    
1651    =item RETURNS;
1652    
1653    The feature-ID as a string.
1654    
1655    =back
1656    
1657  =cut  =cut
1658    
1659  sub fid {  sub fid {
# Line 1019  Line 1666 
1666    
1667  =head3 timestamp  =head3 timestamp
1668    
1669    =over 4
1670    
1671    =item FUNCTION:
1672    
1673    Extract the C<UN*X> timestamp of the annotation.
1674    
1675    =item USAGE:
1676    
1677        my $fid = $annotO->timestamp();
1678    
1679    =item RETURNS;
1680    
1681    The timestamp as a string.
1682    
1683    =back
1684    
1685  =cut  =cut
1686    
1687  sub timestamp {  sub timestamp {
# Line 1038  Line 1701 
1701    
1702  =head3 made_by  =head3 made_by
1703    
1704    =over 4
1705    
1706    =item FUNCTION:
1707    
1708    Extract the annotator's user-name.
1709    
1710    =item USAGE:
1711    
1712        my $fid = $annotO->made_by();
1713    
1714    =item RETURNS;
1715    
1716    The username of the annotator, as a string.
1717    
1718    =back
1719    
1720  =cut  =cut
1721    
1722  sub made_by {  sub made_by {
# Line 1052  Line 1731 
1731    
1732  =head3 text  =head3 text
1733    
1734    =over 4
1735    
1736    =item FUNCTION:
1737    
1738    Extract the text of the annotation.
1739    
1740    =item USGAE:
1741    
1742        my $text = $annotO->text();
1743    
1744    =item RETURNS:
1745    
1746    The text of the annotation, as a string.
1747    
1748    =back
1749    
1750  =cut  =cut
1751    
1752  sub text {  sub text {
# Line 1064  Line 1759 
1759    
1760  =head3 display  =head3 display
1761    
1762    =over 4
1763    
1764    =item FUNCTION:
1765    
1766    Print the contents of an "AnnotationO" object to B<STDOUT>
1767    in human-readable form.
1768    
1769    =item USAGE:
1770    
1771        my $annotO->display();
1772    
1773    =item RETURNS:
1774    
1775    (void)
1776    
1777    =back
1778    
1779  =cut  =cut
1780    
1781  sub display {  sub display {
# Line 1079  Line 1791 
1791  ########################################################################  ########################################################################
1792  use Data::Dumper;  use Data::Dumper;
1793    
1794    =head1 CouplingO
1795    
1796    Methods for accessing the "Functional coupling scores"
1797    of PEGs in close physical proximity to each other.
1798    
1799    =cut
1800    
1801    
1802    
1803  =head3 new  =head3 new
1804    
1805    =over 4
1806    
1807    =item FUNCTION:
1808    
1809    Construct a new "CouplingO" object
1810    encapsulating the "functional coupling" score
1811    between a pair of features in some genome.
1812    
1813    =item USAGE:
1814    
1815        $couplingO = CouplingO->new($figO, $fid1, $fid2, $sc);
1816    
1817    =item C<$figO>
1818    
1819    Parent "FIGO" object.
1820    
1821    =item C<$fid1> and C<$fid2>
1822    
1823    A pair of feature-IDs.
1824    
1825    =item C<$sc>
1826    
1827    A functional-coupling score
1828    
1829    =item RETURNS:
1830    
1831    A "CouplingO" object.
1832    
1833    =back
1834    
1835  =cut  =cut
1836    
1837  sub new {  sub new {
# Line 1100  Line 1851 
1851    
1852  =head3 peg1  =head3 peg1
1853    
1854    =over 4
1855    
1856    =item FUNCTION:
1857    
1858    Returns a "FeatureO" object corresponding to the first FID in a coupled pair.
1859    
1860    =item USAGE:
1861    
1862        my $peg1 = $couplingO->peg1();
1863    
1864    =item RETURNS:
1865    
1866    A "FeatureO" object.
1867    
1868    =back
1869    
1870  =cut  =cut
1871    
1872  sub peg1 {  sub peg1 {
1873      my($self) = @_;      my($self) = @_;
1874    
1875      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1876      return new FeatureO($figO,$self->{_peg1});      return FeatureO->new($figO,$self->{_peg1});
1877  }  }
1878    
1879    
1880    
1881  =head3 peg1  =head3 peg2
1882    
1883    =over 4
1884    
1885    =item FUNCTION:
1886    
1887    Returns a "FeatureO" object corresponding to the second FID in a coupled pair.
1888    
1889    =item USAGE:
1890    
1891        my $peg2 = $couplingO->peg2();
1892    
1893    =item RETURNS:
1894    
1895    A "FeatureO" object.
1896    
1897    =back
1898    
1899  =cut  =cut
1900    
# Line 1119  Line 1902 
1902      my($self) = @_;      my($self) = @_;
1903    
1904      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1905      return new FeatureO($figO,$self->{_peg2});      return FeatureO->new($figO,$self->{_peg2});
1906  }  }
1907    
1908    
1909    
1910  =head3 sc  =head3 sc
1911    
1912    =over 4
1913    
1914    =item FUNCTION:
1915    
1916    Extracts the "functional coupling" score from a "CouplingO" object.
1917    
1918    =item USAGE:
1919    
1920        my $sc = $couplingO->sc();
1921    
1922    =item RETURNS:
1923    
1924    A scalar score.
1925    
1926    =back
1927    
1928  =cut  =cut
1929    
1930  sub sc {  sub sc {
# Line 1138  Line 1937 
1937    
1938  =head3 evidence  =head3 evidence
1939    
1940    =over 4
1941    
1942    =item FUNCTION:
1943    
1944    Fetch the evidence for a "functional coupling" between two close PEGs,
1945    in the form of a list of objects describing the "Pairs of Close Homologs" (PCHs)
1946    supporting the existence of a functional coupling between the two close PEGs.
1947    
1948    =item USAGE:
1949    
1950        my $evidence = $couplingO->evidence();
1951    
1952    =item RETURNS
1953    
1954    List of pairs of "FeatureO" objects.
1955    
1956    =back
1957    
1958  =cut  =cut
1959    
1960  sub evidence {  sub evidence {
# Line 1146  Line 1963 
1963      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1964      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1965      my @ev = ();      my @ev = ();
1966      foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))      foreach my $tuple ($fig->coupling_evidence($self->peg1->id,$self->peg2->id))
1967      {      {
1968          my($peg3,$peg4,$rep) = @$tuple;          my($peg3,$peg4,$rep) = @$tuple;
1969          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
# Line 1160  Line 1977 
1977    
1978  =head3 display  =head3 display
1979    
1980    =over 4
1981    
1982    =item FUNCTION:
1983    
1984    Print the contents of a "CouplingO" object to B<STDOUT> in human-readable form.
1985    
1986    =item USAGE:
1987    
1988        $couplingO->display();
1989    
1990    =item RETURNS:
1991    
1992    (Void)
1993    
1994    =back
1995    
1996  =cut  =cut
1997    
1998  sub display {  sub display {
# Line 1212  Line 2045 
2045    
2046  =head3 usable  =head3 usable
2047    
2048    
2049  =cut  =cut
2050    
2051  sub usable {  sub usable {
# Line 1233  Line 2067 
2067    
2068      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2069      my $subO = $self->{_subO};      my $subO = $self->{_subO};
2070      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) {
2071            $subO = $self->{_subO} = Subsystem->new($self->{_id}, $figO->{_fig});
2072        }
2073    
2074      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
2075  }  }
# Line 1249  Line 2085 
2085    
2086      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2087      my $subO = $self->{_subO};      my $subO = $self->{_subO};
2088      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) {
2089            $subO = $self->{_subO} = Subsystem->new($self->{_id}, $figO->{_fig});
2090        }
2091    
2092      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);
2093  }  }
# Line 1265  Line 2103 
2103    
2104      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2105      my $subO = $self->{_subO};      my $subO = $self->{_subO};
2106      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) {
2107            $subO = $self->{_subO} = Subsystem->new($self->{_id}, $figO->{_fig});
2108        }
2109    
2110      return $subO->get_curator;      return $subO->get_curator;
2111  }  }
# Line 1282  Line 2122 
2122    
2123      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2124      my $subO = $self->{_subO};      my $subO = $self->{_subO};
2125      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) {
2126            $subO = $self->{_subO} = Subsystem->new($self->{_id},$figO->{_fig});
2127        }
2128    
2129      return $subO->get_variant_code_for_genome($genome->id);      return $subO->get_variant_code_for_genome($genome->id);
2130  }  }
# Line 1298  Line 2140 
2140    
2141      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2142      my $subO = $self->{_subO};      my $subO = $self->{_subO};
2143      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) {
2144            $subO = $self->{_subO} = Subsystem->new($self->{_id},$figO->{_fig});
2145        }
2146    
2147      return $subO->get_pegs_from_cell($genome->id,$role->id);      return $subO->get_pegs_from_cell($genome->id,$role->id);
2148  }  }
# Line 1312  Line 2156 
2156    
2157  =head1 FunctionalRoleO  =head1 FunctionalRoleO
2158    
2159    Methods for accessing the functional roles of features.
2160    
2161  =cut  =cut
2162    
2163    
# Line 1408  Line 2254 
2254      my $famO = $self->{_famO};      my $famO = $self->{_famO};
2255      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2256    
2257      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2258  }  }
2259    
   
   
2260  =head3 rep_seqs  =head3 rep_seqs
2261    
2262  =cut  =cut
# Line 1464  Line 2308 
2308  ########################################################################  ########################################################################
2309  =head1 Attribute  =head1 Attribute
2310    
2311    (Note yet implemented.)
2312    
2313  =cut  =cut
2314    
2315  1;  1;
# Line 1474  Line 2320 
2320  =head3 Display all complete, prokaryotic genomes  =head3 Display all complete, prokaryotic genomes
2321    
2322  use FIGO;  use FIGO;
2323  my $figO = new FIGO;  my $figO = FIGO->new();
2324    
2325  foreach $genome ($figO->genomes('complete','prokaryotic'))  foreach $genome ($figO->genomes('complete','prokaryotic'))
2326  {  {
# Line 1484  Line 2330 
2330  #---------------------------------------------  #---------------------------------------------
2331    
2332  use FIG;  use FIG;
2333  my $fig = new FIG;  my $fig = FIG->new();
2334    
2335  foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))  foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
2336  {  {
# Line 1496  Line 2342 
2342  =head3 Show how to access contigs and extract sequence  =head3 Show how to access contigs and extract sequence
2343    
2344  use FIGO;  use FIGO;
2345  my $figO = new FIGO;  my $figO = FIGO->new();
2346    
2347  $genomeId = '83333.1';  $genomeId = '83333.1';
2348  my $genome = new GenomeO($figO,$genomeId);  my $genome = GenomeO->new($figO, $genomeId);
2349    
2350  foreach $contig ($genome->contigs_of)  foreach $contig ($genome->contigs_of)
2351  {  {
# Line 1511  Line 2357 
2357  #---------------------------------------------  #---------------------------------------------
2358    
2359  use FIG;  use FIG;
2360  my $fig = new FIG;  my $fig = FIG->new();
2361    
2362  $genomeId = '83333.1';  $genomeId = '83333.1';
2363    
# Line 1529  Line 2375 
2375  ### accessing data related to features  ### accessing data related to features
2376    
2377  use FIGO;  use FIGO;
2378  my $figO = new FIGO;  my $figO = FIGO->new();
2379    
2380  my $genome = new GenomeO($figO,"83333.1");  my $genome = GenomeO->new($figO, "83333.1");
2381  my $peg  = "fig|83333.1.peg.4";  my $peg  = "fig|83333.1.peg.4";
2382  my $pegO = new FeatureO($figO,$peg);  my $pegO = FeatureO->new($figO, $peg);
2383    
2384  print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",  print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
2385        $pegO->dna_seq,"\n",        $pegO->dna_seq,"\n",
# Line 1548  Line 2394 
2394    
2395    
2396  use FIG;  use FIG;
2397  my $fig = new FIG;  my $fig = FIG->new();
2398    
2399  my $genome = "83333.1";  my $genome = "83333.1";
2400  my $peg  = "fig|83333.1.peg.4";  my $peg  = "fig|83333.1.peg.4";
# Line 1567  Line 2413 
2413  ### accessing similarities  ### accessing similarities
2414    
2415  use FIGO;  use FIGO;
2416  my $figO = new FIGO;  my $figO = FIGO->new();
2417    
2418  $peg  = "fig|83333.1.peg.4";  $peg  = "fig|83333.1.peg.4";
2419  $pegO = new FeatureO($figO,$peg);  $pegO = FeatureO->new($figO, $peg);
2420    
2421  @sims = $pegO->sims;  # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all  @sims = $pegO->sims;  # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
2422                        # sims (including non-FIG sequences                        # sims (including non-FIG sequences
2423  foreach $sim (@sims)  foreach $sim (@sims)
2424  {  {
2425      $peg2  = $sim->id2;      $peg2  = $sim->id2;
2426      $pegO2 = new FeatureO($figO,$peg2);      $pegO2 = FeatureO->new($figO, $peg2);
2427      $func  = $pegO2->function_of;      $func  = $pegO2->function_of;
2428      $sc    = $sim->psc;      $sc    = $sim->psc;
2429      print join("\t",($peg2,$sc,$func)),"\n";      print join("\t",($peg2,$sc,$func)),"\n";
# Line 1587  Line 2433 
2433    
2434    
2435  use FIG;  use FIG;
2436  my $fig = new FIG;  my $fig = FIG new;
2437    
2438  $peg  = "fig|83333.1.peg.4";  $peg  = "fig|83333.1.peg.4";
2439    
# Line 1605  Line 2451 
2451  ### accessing BBHs  ### accessing BBHs
2452    
2453  use FIGO;  use FIGO;
2454  my $figO = new FIGO;  my $figO = FIGO new;
2455    
2456  $peg  = "fig|83333.1.peg.4";  $peg  = "fig|83333.1.peg.4";
2457  $pegO = new FeatureO($figO,$peg);  $pegO = FeatureO->new($figO, $peg);
2458    
2459  @bbhs = $pegO->bbhs;  @bbhs = $pegO->bbhs;
2460  foreach $bbh (@bbhs)  foreach $bbh (@bbhs)
2461  {  {
2462      $peg2  = $bbh->peg2;      $peg2  = $bbh->peg2;
2463      $pegO2 = new FeatureO($figO,$peg2);      $pegO2 = FeatureO->new($figO, $peg2);
2464      $func  = $pegO2->function_of;      $func  = $pegO2->function_of;
2465      $sc    = $bbh->psc;      $sc    = $bbh->psc;
2466      print join("\t",($peg2,$sc,$func)),"\n";      print join("\t",($peg2,$sc,$func)),"\n";
# Line 1623  Line 2469 
2469  #---------------------------------------------  #---------------------------------------------
2470    
2471  use FIG;  use FIG;
2472  my $fig = new FIG;  my $fig = FIG->new();
2473    
2474  $peg  = "fig|83333.1.peg.4";  $peg  = "fig|83333.1.peg.4";
2475    
# Line 1640  Line 2486 
2486  ### accessing annotations  ### accessing annotations
2487    
2488  use FIGO;  use FIGO;
2489  my $figO = new FIGO;  my $figO = FIGO->new();
2490    
2491  $peg  = "fig|83333.1.peg.4";  $peg  = "fig|83333.1.peg.4";
2492  $pegO = new FeatureO($figO,$peg);  $pegO = FeatureO->new($figO, $peg);
2493    
2494  @annotations = $pegO->annotations;  @annotations = $pegO->annotations;
2495    
# Line 1655  Line 2501 
2501  #---------------------------------------------  #---------------------------------------------
2502    
2503  use FIG;  use FIG;
2504  my $fig = new FIG;  my $fig = FIG->new();
2505    
2506  $peg = "fig|83333.1.peg.4";  $peg = "fig|83333.1.peg.4";
2507  @annotations = $fig->feature_annotations($peg);  @annotations = $fig->feature_annotations($peg);
# Line 1672  Line 2518 
2518    
2519    
2520  use FIGO;  use FIGO;
2521  my $figO = new FIGO;  my $figO = FIGO->new();
2522    
2523  my $peg  = "fig|83333.1.peg.4";  my $peg  = "fig|83333.1.peg.4";
2524  my $pegO = new FeatureO($figO,$peg);  my $pegO = FeatureO->new($figO, $peg);
2525  foreach $coupled ($pegO->coupled_to)  foreach $coupled ($pegO->coupled_to)
2526  {  {
2527      print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";      print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
# Line 1691  Line 2537 
2537    
2538    
2539  use FIG;  use FIG;
2540  my $fig = new FIG;  my $fig = FIG->new();
2541    
2542  my $peg1  = "fig|83333.1.peg.4";  my $peg1  = "fig|83333.1.peg.4";
2543  foreach $coupled ($fig->coupled_to($peg1))  foreach $coupled ($fig->coupled_to($peg1))
# Line 1711  Line 2557 
2557  =head3 Accessing Subsystem data  =head3 Accessing Subsystem data
2558    
2559  use FIGO;  use FIGO;
2560  my $figO = new FIGO;  my $figO = FIGO->new();
2561    
2562  foreach $sub ($figO->subsystems)  foreach $sub ($figO->subsystems)
2563  {  {
# Line 1745  Line 2591 
2591  #---------------------------------------------  #---------------------------------------------
2592    
2593  use FIG;  use FIG;
2594  my $fig = new FIG;  my $fig = FIG->new();
2595    
2596  foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)  foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
2597  {  {
2598      $subO = new Subsystem($sub,$fig);      $subO = Subsystem->new($sub, $fig);
2599      $curator = $subO->get_curator;      $curator = $subO->get_curator;
2600      print join("\t",($sub,$curator)),"\n";      print join("\t",($sub,$curator)),"\n";
2601    
# Line 1780  Line 2626 
2626  =head3 Accessing FIGfams  =head3 Accessing FIGfams
2627    
2628  use FIGO;  use FIGO;
2629  my $figO = new FIGO;  my $figO = FIGO->new();
2630    
2631  foreach $fam ($figO->all_figfams)  foreach $fam ($figO->all_figfams)
2632  {  {
# Line 1798  Line 2644 
2644  use FigFam;  use FigFam;
2645  use FigFams;  use FigFams;
2646    
2647  my $fig = new FIG;  my $fig = FIG->new();
2648  my $figfams = new FigFams($fig);  my $figfams = FigFams->new($fig);
2649    
2650  foreach $fam ($figfams->all_families)  foreach $fam ($figfams->all_families)
2651  {  {
2652      my $figfam = new FigFam($fig,$fam);      my $figfam = FigFam->new($fig, $fam);
2653      print join("\t",($fam,$figfam->family_function)),"\n";      print join("\t",($fam,$figfam->family_function)),"\n";
2654      foreach $peg ($figfam->list_members)      foreach $peg ($figfam->list_members)
2655      {      {
# Line 1816  Line 2662 
2662  =head3 Placing a sequence into a FIGfam  =head3 Placing a sequence into a FIGfam
2663    
2664  use FIGO;  use FIGO;
2665  my $figO = new FIGO;  my $figO = FIGO->new();
2666    
2667  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2668  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
# Line 1846  Line 2692 
2692  use FigFam;  use FigFam;
2693  use FigFams;  use FigFams;
2694    
2695  my $fig = new FIG;  my $fig = FIG->new();
2696  my $figfams = new FigFams($fig);  my $figfams = FigFams->new($fig);
2697    
2698  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2699  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
# Line 1876  Line 2722 
2722  =head3 Getting representative sequences for a FIGfam  =head3 Getting representative sequences for a FIGfam
2723    
2724  use FIGO;  use FIGO;
2725  my $figO = new FIGO;  my $figO = FIGO->new();
2726    
2727  $fam         = "FIG102446";  $fam         = "FIG102446";
2728  my $famO     = &FigFamO::new('FigFamO',$figO,$fam);  my $famO     = &FigFamO::new('FigFamO',$figO,$fam);
# Line 1893  Line 2739 
2739  use FigFam;  use FigFam;
2740  use FigFams;  use FigFams;
2741    
2742  my $fig = new FIG;  my $fig = FIG->new();
2743    
2744  $fam         = "FIG102446";  $fam         = "FIG102446";
2745  my $famO     = new FigFam($fig,$fam);  my $famO     = FigFam->new($fig, $fam);
2746  my @rep_seqs = $famO->representatives;  my @rep_seqs = $famO->representatives;
2747    
2748  foreach $seq (@rep_seqs)  foreach $seq (@rep_seqs)
# Line 1911  Line 2757 
2757  =head3 Testing for membership in FIGfam  =head3 Testing for membership in FIGfam
2758    
2759  use FIGO;  use FIGO;
2760  my $figO = new FIGO;  my $figO = FIGO->new();
2761    
2762  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2763  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
# Line 1943  Line 2789 
2789  use FigFam;  use FigFam;
2790  use FigFams;  use FigFams;
2791    
2792  my $fig = new FIG;  my $fig = FIG->new();
2793    
2794  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS  $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2795  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH  AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
# Line 1956  Line 2802 
2802  $seq =~ s/\n//gs;  $seq =~ s/\n//gs;
2803    
2804  $fam                  = "FIG102446";  $fam                  = "FIG102446";
2805  my $famO              = new FigFam($fig,$fam);  my $famO              = FigFam->new($fig, $fam);
2806  my($should_be, $sims) = $famO->should_be_member($seq);  my($should_be, $sims) = $famO->should_be_member($seq);
2807    
2808  if ($should_be)  if ($should_be)

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.33

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3