[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.8, Thu Feb 22 14:28:32 2007 UTC revision 1.16, Sun Mar 11 00:21:50 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 Methods  =head1 FIGO
79    
80    The effective "base class" containing a few "top-level" methods.
81    
82    =cut
83    
84    
85  =head3 new  =head3 new
86    
# Line 80  Line 133 
133  C<< my @tax_ids = $figo->genomes( @constraints ); >>  C<< my @tax_ids = $figo->genomes( @constraints ); >>
134    
135  =item @constraints  =item @constraints
136    
137  One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.  One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
138    
139  =item RETURNS: List of Tax-IDs.  =item RETURNS: List of Tax-IDs.
140    
141  =item EXAMPLE: L<Display all complete, prokaryotic genomes>  =item EXAMPLE:
142    
143    L<Display all complete, prokaryotic genomes>
144    
145  =back  =back
146    
# Line 141  Line 197 
197  =over4  =over4
198    
199  =item RETURNS:  =item RETURNS:
200    
201  List of all subsystems.  List of all subsystems.
202    
203  =item EXAMPLE: L<Accessing Subsystem data>  =item EXAMPLE:
204    
205    L<Accessing Subsystem data>
206    
207  =back  =back
208    
# Line 188  Line 247 
247    
248  =over4  =over4
249    
250  =item USAGE:  C<< foreach $fam ($figO->all_figfams) { #...Do something } >>  =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 RETURNS: List of FIGfam Objects  =item EXAMPLE:
259    
260  =item EXAMPLE: L<Accessing FIGfams>  L<Accessing FIGfams>
261    
262  =back  =back
263    
# Line 211  Line 276 
276    
277  =over4  =over4
278    
279  =item USAGE:   C<< my ($fam, $sims) = $figO->family_containing($seq); >>  =item USAGE:
280    
281    C<< my ($fam, $sims) = $figO->family_containing($seq); >>
282    
283    =item $seq:
284    
285  =item $seq:    A protein translation string.      A protein translation string.
286    
287  =item RETURNS:  =item RETURNS:
288    
289        $fam:  A FIGfam Object.        $fam:  A FIGfam Object.
290    
291        $sims: A set of similarity objects.        $sims: A set of similarity objects.
292    
293  =item EXAMPLE: L<Placing a sequence into a FIGfam>  =item EXAMPLE: L<Placing a sequence into a FIGfam>
# Line 251  Line 322 
322    
323  =cut  =cut
324    
325    
326  =head3 new  =head3 new
327    
328  Constructor of GenomeO objects.  Constructor of GenomeO objects.
# Line 258  Line 330 
330  =over4  =over4
331    
332  =item USAGE:  =item USAGE:
333    
334  C<< my $org = GenomeO->new($figo, $tax_id); >>  C<< my $org = GenomeO->new($figo, $tax_id); >>
335    
336  =item RETURNS: A new GenomeO object.  =item RETURNS:
337    
338        A new GenomeO object.
339    
340  =back  =back
341    
# Line 281  Line 356 
356    
357  =over4  =over4
358    
359  =item USAGE:   C<< my $tax_id = $org->id(); >>  =item USAGE:
360    
361    C<< my $tax_id = $org->id(); >>
362    
363    =item RETURNS:
364    
365  =item RETURNS: Taxonomy-ID of GenomeO object.      Taxonomy-ID of GenomeO object.
366    
367  =back  =back
368    
# Line 301  Line 380 
380    
381  =over4  =over4
382    
383  =item USAGE:   C<< $gs = $genome->genus_species(); >>  =item USAGE:
384    
385    C<< $gs = $genome->genus_species(); >>
386    
387    =item RETURNS:
388    
389  =item RETURNS: Genus-species-strain string      Genus-species-strain string
390    
391  =back  =back
392    
# Line 321  Line 404 
404    
405  =over4  =over4
406    
407  =item RETURNS: List of C<contig> objects contained in a C<GenomeO> object.  =item RETURNS:
408    
409        List of C<contig> objects contained in a C<GenomeO> object.
410    
411  =item EXAMPLE: L<Show how to access contigs and extract sequence>  =item EXAMPLE:
412    
413    L<Show how to access contigs and extract sequence>
414    
415  =back  =back
416    
# Line 359  Line 446 
446    
447  =over4  =over4
448    
449  =item USAGE:   C<< $genome->display(); >>  =item USAGE:
450    
451  =item RETURNS: Null  C<< $genome->display(); >>
452    
453    =item RETURNS:
454    
455        (Void)
456    
457  =back  =back
458    
# Line 393  Line 484 
484  =over4  =over4
485    
486  =item USAGE:  =item USAGE:
487    
488  C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>  C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>
489    
490  =item $figO: A FIGO object.  =item $figO:
491    
492  =item $genomeId: Taxon-ID for the genome the contig is from.      Parent FIGO object.
493    
494  =item $contigId: Identifier for the contig  =item $genomeId:
495    
496  =item RETURNS: A "ContigO" object.      Taxon-ID for the genome the contig is from.
497    
498    =item $contigId:
499    
500        Identifier for the contig
501    
502    =item RETURNS:
503    
504        A "ContigO" object.
505    
506  =back  =back
507    
# Line 423  Line 523 
523    
524  =over4  =over4
525    
526  =item RETURNS: Sequence ID string of "ContigO" object  =item RETURNS:
527    
528        Sequence ID string of "ContigO" object
529    
530  =back  =back
531    
# Line 441  Line 543 
543  =over4  =over4
544    
545  =item USAGE:  =item USAGE:
     C<< my $tax_id = $contig->genome(); >>  
546    
547  =item RETURNS: GenomeO object containing the contig object.  C<< my $tax_id = $contig->genome->id(); >>
548    
549    =item RETURNS:
550    
551        Tax-ID of the GenomeO object containing the contig object.
552    
553  =back  =back
554    
# Line 452  Line 557 
557  sub genome {  sub genome {
558      my($self) = @_;      my($self) = @_;
559    
560      return $self->{_genome};      my $figO = $self->{_figO};
561        return new GenomeO($figO,$self->{_genome});
562  }  }
563    
564    
# Line 462  Line 568 
568  =over4  =over4
569    
570  =item USAGE:  =item USAGE:
571    
572      C<< my $len = $contig->contig_length(); >>      C<< my $len = $contig->contig_length(); >>
573    
574  =item RETURNS: Length of contig's DNA sequence.  =item RETURNS:
575    
576        Length of contig's DNA sequence.
577    
578  =back  =back
579    
# Line 474  Line 583 
583      my($self) = @_;      my($self) = @_;
584    
585      my $fig = $self->{_figO}->{_fig};      my $fig = $self->{_figO}->{_fig};
586      my $contig_lengths = $fig->contig_lengths($self->genome);      my $contig_lengths = $fig->contig_lengths($self->genome->id);
587      return $contig_lengths->{$self->id};      return $contig_lengths->{$self->id};
588  }  }
589    
# Line 484  Line 593 
593  =over4  =over4
594    
595  =item USAGE:  =item USAGE:
596    
597      C<< my $seq = $contig->dna_seq(beg, $end); >>      C<< my $seq = $contig->dna_seq(beg, $end); >>
598    
599  =item $beg: Begining point of DNA subsequence  =item $beg:
600    
601        Begining point of DNA subsequence
602    
603    =item $end:
604    
605  =item $end: End point of DNA subsequence      End point of DNA subsequence
606    
607  =item RETURNS: string of DNA sequence from $beg to $end  =item RETURNS:
608    
609        string of DNA sequence running from $beg to $end
610  (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)  (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
611    
612  =back  =back
# Line 506  Line 621 
621      if (($beg && (&FIG::between(1,$beg,$max))) &&      if (($beg && (&FIG::between(1,$beg,$max))) &&
622          ($end && (&FIG::between(1,$end,$max))))          ($end && (&FIG::between(1,$end,$max))))
623      {      {
624          return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));          return $fig->dna_seq($self->genome->id,join("_",($self->id,$beg,$end)));
625      }      }
626      else      else
627      {      {
# Line 527  Line 642 
642    
643  =over4  =over4
644    
645  =item RETURNS: Nil  =item RETURNS:
646    
647        (Void)
648    
649  =back  =back
650    
# Line 536  Line 653 
653  sub display {  sub display {
654      my($self) = @_;      my($self) = @_;
655    
656      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";      print join("ContigO",$self->genome->id,$self->id,$self->contig_length),"\n";
657    }
658    
659    sub features_in_region {
660        my($self,$beg,$end) = @_;
661        my $figO = $self->{_figO};
662        my $fig = $figO->{_fig};
663    
664        my($features) = $fig->genes_in_region($self->genome->id,$self->id,$beg,$end);
665        return map { new FeatureO($figO,$_) } @$features;
666  }  }
667    
668    
# Line 548  Line 674 
674    
675  =head1 FeatureO  =head1 FeatureO
676    
677  =cut  Methods for working with features on "ContigO" objects.
678    
679    =cut
680    
681    
682  =head1 new  =head3 new
683    
684  Constructor of "FeatureO" objects  Constructor of "FeatureO" objects
685    
686    =over 4
687    
688    =item USAGE:
689    
690    C<< my $feature = FeatureO->new( $figO, $fid ); >>
691    
692    =item C<$figO>:
693    
694    "Base" FIGO object.
695    
696    =item C<$fid>:
697    
698    Feature-ID for new feature
699    
700    =item RETURNS:
701    
702    A newly created "FeatureO" object.
703    
704    =back
705    
706  =cut  =cut
707    
708  sub new {  sub new {
# Line 569  Line 716 
716  }  }
717    
718    
719    
720  =head3 id  =head3 id
721    
722    =over 4
723    
724    =item USAGE:
725    
726    C<< my $fid = $feature->id(); >>
727    
728    =item RETURNS:
729    
730    The FID (Feature ID) of a "FeatureO" object.
731    
732    =back
733    
734  =cut  =cut
735    
736  sub id {  sub id {
# Line 583  Line 743 
743    
744  =head3 genome  =head3 genome
745    
746    =over 4
747    
748    =item USAGE:
749    
750    C<< my $taxid = $feature->genome(); >>
751    
752    =item RETURNS:
753    
754    The TAxon-ID for the "GenomeO" object containg the feature.
755    
756    =back
757    
758  =cut  =cut
759    
760  sub genome {  sub genome {
761      my($self) = @_;      my($self) = @_;
762        my $figO = $self->{_figO};
763      $self->id =~ /^fig\|(\d+\.\d+)/;      $self->id =~ /^fig\|(\d+\.\d+)/;
764      return $1;      return new GenomeO($figO,$1);
765  }  }
766    
767    
768    
769  =head3 type  =head3 type
770    
771    =over 4
772    
773    =item USAGE:
774    
775    C<< my $feature_type = $feature->type(); >>
776    
777    =item RETURNS:
778    
779    The feature object's "type" (e.g., "peg," "rna," etc.)
780    
781    =back
782    
783  =cut  =cut
784    
785  sub type {  sub type {
# Line 607  Line 791 
791    
792    
793    
   
794  =head3 location  =head3 location
795    
796    =over 4
797    
798    =item USAGE:
799    
800    C<< my $loc = $feature->location(); >>
801    
802    =item RETURNS:
803    
804    A string representing the feature object's location on the genome's DNA,
805    in SEED "tbl format" (i.e., "contig_beging_end").
806    
807    =back
808    
809  =cut  =cut
810    
811  sub location {  sub location {
# Line 620  Line 816 
816  }  }
817    
818    
819    =head3 contig
820    
821    =over 4
822    
823    =item USAGE:
824    
825    C<< my $contig = $feature->contig(); >>
826    
827    =item RETURNS:
828    
829    A "ContigO" object to access the contig data
830    for the contig the feature is on.
831    
832    =back
833    
834    =cut
835    
836    sub contig {
837        my($self) = @_;
838    
839        my $figO = $self->{_figO};
840        my $loc      = $self->location;
841        my $genomeID = $self->genome->id;
842        return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;
843    }
844    
845    
846    
847    =head3 begin
848    
849    =over 4
850    
851    =item USAGE:
852    
853    C<< my $beg = $feature->begin(); >>
854    
855    =item RETURNS:
856    
857    The numerical coordinate of the first base of the feature.
858    
859    =back
860    
861    =cut
862    
863    sub begin {
864        my($self) = @_;
865    
866        my $loc = $self->location;
867        return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
868    }
869    
870    
871    
872    =head3 end
873    
874    =over 4
875    
876    =item USAGE:
877    
878    C<< my $end = $feature->end(); >>
879    
880    =item RETURNS:
881    
882    The numerical coordinate of the last base of the feature.
883    
884    =back
885    
886    =cut
887    
888    sub end {
889        my($self) = @_;
890    
891        my $loc = $self->location;
892        return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
893    }
894    
895    
896    
897  =head3 dna_seq  =head3 dna_seq
898    
899    =over 4
900    
901    =item USAGE:
902    
903    C<< my $dna_seq = $feature->dna_seq(); >>
904    
905    =item RETURNS:
906    
907    A string contining the DNA subsequence of the contig
908    running from the first to the last base of the feature.
909    
910    If ($beg > $end), the reverse complement subsequence is returned.
911    
912    =back
913    
914  =cut  =cut
915    
916  sub dna_seq {  sub dna_seq {
# Line 638  Line 926 
926    
927  =head3 prot_seq  =head3 prot_seq
928    
929    =over 4
930    
931    =item USAGE:
932    
933    C<< my $dna_seq = $feature->prot_seq(); >>
934    
935    =item RETURNS:
936    
937    A string contining the protein translation of the feature (if it exists),
938    or the "undef" value if the feature does not exist or is not a PEG.
939    
940    =back
941    
942  =cut  =cut
943    
944  sub prot_seq {  sub prot_seq {
# Line 653  Line 954 
954    
955  =head3 function_of  =head3 function_of
956    
957    =over 4
958    
959    =item USAGE:
960    
961    C<< my $func = $feature->function_of(); >>
962    
963    =item RETURNS:
964    
965    A string containing the function assigned to the feature,
966    or the "undef" value if no function has been assigned.
967    
968    =back
969    
970  =cut  =cut
971    
972  sub function_of {  sub function_of {
# Line 667  Line 981 
981    
982  =head3 coupled_to  =head3 coupled_to
983    
984    =over 4
985    
986    =item USAGE:
987    
988    C<< my @coupled_features = $feature->coupled_to(); >>
989    
990    =item RETURNS:
991    
992    A list of L<CouplingO> objects describing the evidence for functional coupling
993    between this feature and other nearby features.
994    
995    =back
996    
997  =cut  =cut
998    
999  sub coupled_to {  sub coupled_to {
1000      my($self) = @_;      my($self) = @_;
1001    
1002      ($self->type eq "peg") || return undef;      ($self->type eq "peg") || return ();
1003      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1004      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1005      my $peg1 = $self->id;      my $peg1 = $self->id;
# Line 689  Line 1016 
1016    
1017  =head3 annotations  =head3 annotations
1018    
1019    =over 4
1020    
1021    =item USAGE:
1022    
1023    C<< my @annot_list = $feature->annotations(); >>
1024    
1025    =item RETURNS:
1026    
1027    A list of L<AnnotationO> objects allowing access to the annotations for this feature.
1028    
1029    =back
1030    
1031  =cut  =cut
1032    
1033  sub annotations {  sub annotations {
# Line 700  Line 1039 
1039      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
1040  }  }
1041    
1042    
1043    =head3 in_subsystems
1044    
1045    =over 4
1046    
1047    =item USAGE:
1048    
1049    C<< my @subsys_list = $feature->in_subsystems(); >>
1050    
1051    =item RETURNS:
1052    
1053    A list of L<SubsystemO> objects allowing access to the subsystems
1054    that this feature particupates in.
1055    
1056    =back
1057    
1058    =cut
1059    
1060  sub in_subsystems {  sub in_subsystems {
1061      my($self) = @_;      my($self) = @_;
1062      my $figO = $self->{_figO};      my $figO = $self->{_figO};
# Line 711  Line 1068 
1068    
1069  =head3 possibly_truncated  =head3 possibly_truncated
1070    
1071    =over 4
1072    
1073    =item USAGE:
1074    
1075    C<< my $trunc = $feature->possibly_truncated(); >>
1076    
1077    =item RETURNS:
1078    
1079    Boolean C<TRUE> if the feature may be truncated;
1080    boolean C<FALSE> otherwise.
1081    
1082    =back
1083    
1084  =cut  =cut
1085    
1086  sub possibly_truncated {  sub possibly_truncated {
# Line 725  Line 1095 
1095    
1096  =head3 possible_frameshift  =head3 possible_frameshift
1097    
1098    =over 4
1099    
1100    =item USAGE:
1101    
1102    C<< my $fs = $feature->possible_frameshift(); >>
1103    
1104    =item RETURNS:
1105    
1106    Boolean C<TRUE> if the feature may be a frameshifted fragment;
1107    boolean C<FALSE> otherwise.
1108    
1109    (NOTE: This is a crude prototype implementation,
1110    and is mostly as an example of how to code using FIGO.)
1111    
1112    =back
1113    
1114  =cut  =cut
1115    
1116  sub possible_frameshift {  sub possible_frameshift {
# Line 752  Line 1138 
1138                      my $contig = $1;                      my $contig = $1;
1139                      my $beg    = $2;                      my $beg    = $2;
1140                      my $end = $3;                      my $end = $3;
1141                      my $contigO = new ContigO($figO,$self->genome,$contig);                      my $contigO = new ContigO($figO,$self->genome->id,$contig);
1142                      my $begA = &max(1,$beg - $adjL);                      my $begA = &max(1,$beg - $adjL);
1143                      my $endA = &min($end+$adjR,$contigO->contig_length);                      my $endA = &min($end+$adjR,$contigO->contig_length);
1144                      my $dna  = $contigO->dna_seq($begA,$endA);                      my $dna  = $contigO->dna_seq($begA,$endA);
# Line 776  Line 1162 
1162                                       @{$db_seq_out->[6]};                                       @{$db_seq_out->[6]};
1163                      my @prot = map { [$_->[0],$_->[1]] } @hsps;                      my @prot = map { [$_->[0],$_->[1]] } @hsps;
1164                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;
1165                      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))
1166                      {                      {
1167                          return 1;                          return 1;
1168                      }                      }
# Line 791  Line 1177 
1177    
1178  =head3 run  =head3 run
1179    
1180    (Note: This function should be considered "PRIVATE")
1181    
1182    =over 4
1183    
1184    =item FUNCTION:
1185    
1186    Passes a string containing a command to be execture by the "system" shell command.
1187    
1188    =item USAGE:
1189    
1190    C<< $feature->run($cmd); >>
1191    
1192    =item RETURNS:
1193    
1194    Nil if the execution of C<$cmd> was successful;
1195    aborts with traceback if C<$cmd> fails.
1196    
1197    =back
1198    
1199  =cut  =cut
1200    
1201  sub run {  sub run {
# Line 802  Line 1207 
1207    
1208  =head3 max  =head3 max
1209    
1210    (Note: This function should be considered "PRIVATE")
1211    
1212    =over 4
1213    
1214    =item USAGE:
1215    
1216    C<< my $max = $feature->max($x, $y); >>
1217    
1218    =item C<$x>
1219    
1220    Numerical value.
1221    
1222    =item C<$y>
1223    
1224    Numerical value.
1225    
1226    =items RETURNS:
1227    
1228    The larger of the two numerical values C<$x> and C<$y>.
1229    
1230    =back
1231    
1232  =cut  =cut
1233    
1234  sub max {  sub max {
# Line 813  Line 1240 
1240    
1241  =head3 min  =head3 min
1242    
1243    (Note: This function should be considered "PRIVATE")
1244    
1245    =over 4
1246    
1247    =item USAGE:
1248    
1249    C<< my $min = $feature->min($x, $y); >>
1250    
1251    =item C<$x>
1252    
1253    Numerical value.
1254    
1255    =item C<$y>
1256    
1257    Numerical value.
1258    
1259    =item RETURNS:
1260    
1261    The smaller of the two numerical values C<$x> and C<$y>.
1262    
1263    =back
1264    
1265  =cut  =cut
1266    
1267  sub min {  sub min {
# Line 824  Line 1273 
1273    
1274  =head3 covers  =head3 covers
1275    
1276    (Question: Should this function be considered "PRIVATE" ???)
1277    
1278    USAGE:
1279        C<< if (&covers(\@hits, $len, $diff, $must_shift)) { #...Do stuff } >>
1280    
1281    Returns boolean C<TRUE> if a set of BLAST HSPs "cover" more than 90%
1282    of the database sequence(?).
1283    
1284  =cut  =cut
1285    
1286  sub covers {  sub covers {
1287      my($hsps,$ln,$diff) = @_;      my($hsps,$ln,$diff,$must_shift) = @_;
1288    
1289      my $hsp1 = shift @$hsps;      my $hsp1 = shift @$hsps;
1290      my $hsp2;      my $hsp2;
1291      while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}      my $merged = 0;
1292      return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));      while ($hsp1 && ($hsp2 = shift @$hsps) &&
1293               ($must_shift ? &diff_frames($hsp1,$hsp2) : 1) &&
1294               ($hsp1 = &merge($hsp1,$hsp2,$diff))) { $merged = 1 }
1295        return ($merged && $hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
1296    }
1297    
1298    sub diff_frames {
1299        my($hsp1,$hsp2) = @_;
1300        return (($hsp1->[0] % 3) != ($hsp2->[0] % 3));
1301  }  }
1302    
1303    
1304    
1305  =head3 merge  =head3 merge
1306    
1307    Merge two HSPs unless their overlap or separation is too large.
1308    
1309    RETURNS: Merged boundaries if merger succeeds, and C<undef> if merger fails.
1310    
1311  =cut  =cut
1312    
1313  sub merge {  sub merge {
# Line 853  Line 1322 
1322    
1323  =head3 sims  =head3 sims
1324    
1325    =over 4
1326    
1327    =item FUNCTION:
1328    
1329    Returns precomputed "Sim.pm" objects from the SEED.
1330    
1331    =item USAGE:
1332    
1333    C<< my @sims = $pegO->sims( -all, -cutoff => 1.0e-10); >>
1334    
1335    C<< my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10); >>
1336    
1337    =item RETURNS: List of sim objects.
1338    
1339    =back
1340    
1341  =cut  =cut
1342    
1343  use Sim;  use Sim;
# Line 873  Line 1358 
1358    
1359  =head3 bbhs  =head3 bbhs
1360    
1361    =over 4
1362    
1363    =item FUNCTION:
1364    
1365    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1366    corresponding to the pre-computed BBHs for that PEG.
1367    
1368    =item USAGE:
1369    
1370    C<< my @bbhs = $pegO->bbhs(); >>
1371    
1372    =item List of BBHO objects.
1373    
1374    =back
1375    
1376  =cut  =cut
1377    
1378  sub bbhs {  sub bbhs {
# Line 892  Line 1392 
1392    
1393  =head3 display  =head3 display
1394    
1395    Prints info about a "FeatureO" object to STDOUT.
1396    
1397    USAGE:
1398    
1399    C<< $pegO->display(); >>
1400    
1401  =cut  =cut
1402    
1403  sub display {  sub display {
# Line 910  Line 1416 
1416    
1417  =head1 BBHO  =head1 BBHO
1418    
1419    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1420    
1421  =cut  =cut
1422    
1423    
1424  =head3 new  =head3 new
1425    
1426    Constructor of BBHO objects.
1427    
1428    (NOTE: The "average user" should never need to invoke this method.)
1429    
1430  =cut  =cut
1431    
1432  sub new {  sub new {
# Line 930  Line 1442 
1442  }  }
1443    
1444    
1445    
1446  =head3 peg1  =head3 peg1
1447    
1448    =over 4
1449    
1450    =item USAGE:
1451    
1452    C<< my $peg1 = $bbh->peg1(); >>
1453    
1454    =item RETURNS:
1455    
1456    A "FeatureO" object corresponding to the "query" sequence
1457    in a BBH pair.
1458    
1459    =back
1460    
1461  =cut  =cut
1462    
1463  sub peg1 {  sub peg1 {
# Line 943  Line 1469 
1469    
1470  =head3 peg2  =head3 peg2
1471    
1472    =over 4
1473    
1474    =item USAGE:
1475    
1476    C<< my $peg2 = $bbh->peg2(); >>
1477    
1478    =item RETURNS:
1479    
1480    A "FeatureO" object corresponding to the "database" sequence
1481    in a BBH pair.
1482    
1483    =back
1484    
1485  =cut  =cut
1486    
1487  sub peg2 {  sub peg2 {
# Line 956  Line 1495 
1495    
1496  =head3 psc  =head3 psc
1497    
1498    =over 4
1499    
1500    =item USAGE:
1501    
1502    C<< my $psc = $bbh->psc(); >>
1503    
1504    =item RETURNS:
1505    
1506    The numerical value of the BLAST E-value for the pair.
1507    
1508    =back
1509    
1510  =cut  =cut
1511    
1512  sub psc {  sub psc {
# Line 968  Line 1519 
1519    
1520  =head3 norm_bitscore  =head3 norm_bitscore
1521    
1522    
1523    =over 4
1524    
1525    =item USAGE:
1526    
1527    C<< my $bsc = $bbh->norm_bitscore(); >>
1528    
1529    =item RETURNS:
1530    
1531    The "BLAST bit-score per aligned character" for the pair.
1532    
1533    =back
1534    
1535  =cut  =cut
1536    
1537  sub norm_bitscore {  sub norm_bitscore {
# Line 984  Line 1548 
1548    
1549  =head1 AnnotationO  =head1 AnnotationO
1550    
1551    Methods for accessing SEED annotations.
1552    
1553  =cut  =cut
1554    
1555    
# Line 1079  Line 1645 
1645  ########################################################################  ########################################################################
1646  use Data::Dumper;  use Data::Dumper;
1647    
1648    =head1 CouplingO
1649    
1650    Methods for accessing the "Functional coupling scores"
1651    of PEGs in close physical proximity to each other.
1652    
1653    =cut
1654    
1655    
1656    
1657  =head3 new  =head3 new
1658    
1659  =cut  =cut
# Line 1212  Line 1787 
1787    
1788  =head3 usable  =head3 usable
1789    
1790    
1791  =cut  =cut
1792    
1793  sub usable {  sub usable {
# Line 1234  Line 1810 
1810      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1811      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1812      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
     if (! defined($subO)) { return undef }  
1813    
1814      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1815  }  }
1816    
1817    
1818    
1819  =head3 roles  =head3 roles
1820    
1821  =cut  =cut
# Line 1249  Line 1826 
1826      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1827      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1828      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1829      if (! defined($subO)) { return undef }  
1830      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);
1831  }  }
1832    
1833    
1834    
1835  =head3 curator  =head3 curator
1836    
1837  =cut  =cut
# Line 1263  Line 1842 
1842      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1843      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1844      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1845      return defined($subO) ? $subO->get_curator : undef;  
1846        return $subO->get_curator;
1847  }  }
1848    
1849    
# Line 1279  Line 1859 
1859      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1860      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1861      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
     if (! defined($subO)) { return undef }  
1862    
1863      return $subO->get_variant_code_for_genome($genome->id);      return $subO->get_variant_code_for_genome($genome->id);
1864  }  }
# Line 1296  Line 1875 
1875      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1876      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1877      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
     if (! defined($subO)) { return undef }  
1878    
1879      return $subO->get_pegs_from_cell($genome->id,$role->id);      return $subO->get_pegs_from_cell($genome->id,$role->id);
1880  }  }
# Line 1310  Line 1888 
1888    
1889  =head1 FunctionalRoleO  =head1 FunctionalRoleO
1890    
1891    Methods for accessing the functional roles of features.
1892    
1893  =cut  =cut
1894    
1895    
# Line 1462  Line 2042 
2042  ########################################################################  ########################################################################
2043  =head1 Attribute  =head1 Attribute
2044    
2045    (Note yet implemented.)
2046    
2047  =cut  =cut
2048    
2049  1;  1;

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.16

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3