[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.1, Tue Nov 21 18:20:53 2006 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 25  Line 73 
73  use Tracer;  use Tracer;
74  use Data::Dumper;  use Data::Dumper;
75  use FigFams;  use FigFams;
76    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) = @_;
# Line 41  Line 113 
113    
114      my $self = {};      my $self = {};
115      $self->{_fig} = $fig;      $self->{_fig} = $fig;
116        $self->{_tmp_dir} = $FIG_Config::temp;
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 88  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 95  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 104  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 111  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 127  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 140  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 153  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 161  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 170  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 190  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 218  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 226  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    
     my $fig = $self->{_figO}->{_fig};  
     my $fid = $self->id;  
     my @loc = $fig->feature_location($fid);  
     return $fig->dna_seq(&FIG::genome_of($fid),@loc);  
 }  
695    
696  sub prot_seq {  ########################################################################
697      my($self) = @_;  package FeatureO;
698    ########################################################################
699    use Data::Dumper;
700    
701      ($self->type eq "peg") || return undef;  =head1 FeatureO
     my $fig = $self->{_figO}->{_fig};  
     my $fid = $self->id;  
     return $fig->get_translation($fid);  
 }  
702    
703  sub function_of {  Methods for working with features on "ContigO" objects.
     my($self) = @_;  
704    
705      my $fig = $self->{_figO}->{_fig};  =cut
     my $fid = $self->id;  
     return scalar $fig->function_of($fid);  
 }  
706    
 sub coupled_to {  
     my($self) = @_;  
707    
708      ($self->type eq "peg") || return undef;  =head3 new
     my $figO = $self->{_figO};  
     my $fig  = $figO->{_fig};  
     my $peg1 = $self->id;  
     my @coupled = ();  
     foreach my $tuple ($fig->coupled_to($peg1))  
     {  
         my($peg2,$sc) = @$tuple;  
         push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));  
     }  
     return @coupled;  
 }  
709    
710  sub annotations {  Constructor of "FeatureO" objects
     my($self) = @_;  
711    
712      my $figO = $self->{_figO};  =over 4
     my $fig  = $figO->{_fig};  
713    
714      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);  =item USAGE:
 }  
715    
716  sub display {  C<< my $feature = FeatureO->new( $figO, $fid ); >>
     my($self) = @_;  
717    
718      print join("\t",$self->id,$self->location,$self->function_of),"\n",  =item C<$figO>:
           $self->dna_seq,"\n",  
           $self->prot_seq,"\n";  
 }  
719    
720  package AnnotationO;  "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 {  sub new {
735      my($class,$fid,$timestamp,$who,$text) = @_;      my($class,$figO,$fid) = @_;
736    
737        ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
738      my $self = {};      my $self = {};
739      $self->{_fid} = $fid;      $self->{_figO} = $figO;
740      $self->{_timestamp} = $timestamp;      $self->{_id} = $fid;
     $self->{_who} = $who;  
     $self->{_text} = $text;  
741      return bless $self, $class;      return bless $self, $class;
742  }  }
743    
 sub fid {  
     my($self) = @_;  
744    
     return $self->{_fid};  
 }  
745    
746  sub timestamp {  =head3 id
     my($self,$convert) = @_;  
747    
748      if ($convert)  =over 4
     {  
         return scalar localtime($self->{_timestamp});  
     }  
     else  
     {  
         return $self->{_timestamp};  
     }  
 }  
749    
750  sub made_by {  =item USAGE:
     my($self) = @_;  
751    
752      my $who = $self->{_who};  C<< my $fid = $feature->id(); >>
     $who =~ s/^master://i;  
     return $who;  
 }  
753    
754  sub text {  =item RETURNS:
     my($self) = @_;  
755    
756      my $text = $self->{_text};  The FID (Feature ID) of a "FeatureO" object.
     return $text;  
 }  
757    
758  sub display {  =back
759    
760    =cut
761    
762    sub id {
763      my($self) = @_;      my($self) = @_;
764    
765      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";      return $self->{_id};
766  }  }
767    
 package CouplingO;  
768    
 use Data::Dumper;  
769    
770  sub new {  =head3 genome
     my($class,$figO,$peg1,$peg2,$sc) = @_;  
771    
772      ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;  =over 4
     ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;  
     my $self = {};  
     $self->{_figO} = $figO;  
     $self->{_peg1} = $peg1;  
     $self->{_peg2} = $peg2;  
     $self->{_sc}   = $sc;  
     return bless $self, $class;  
 }  
773    
774  sub peg1 {  =item USAGE:
     my($self) = @_;  
775    
776      return $self->{_peg1};  C<< my $taxid = $feature->genome(); >>
 }  
777    
778  sub peg2 {  =item RETURNS:
     my($self) = @_;  
779    
780      return $self->{_peg2};  The TAxon-ID for the "GenomeO" object containg the feature.
 }  
781    
782  sub sc {  =back
     my($self) = @_;  
783    
784      return $self->{_sc};  =cut
 }  
785    
786  sub evidence {  sub genome {
787      my($self) = @_;      my($self) = @_;
   
788      my $figO = $self->{_figO};      my $figO = $self->{_figO};
789      my $fig  = $figO->{_fig};      $self->id =~ /^fig\|(\d+\.\d+)/;
790      my @ev = ();      return new GenomeO($figO,$1);
     foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))  
     {  
         my($peg3,$peg4,$rep) = @$tuple;  
         push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),  
                   &FeatureO::new('FeatureO',$figO,$peg4),  
                   $rep]);  
     }  
     return @ev;  
791  }  }
792    
 sub display {  
     my($self) = @_;  
793    
     print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";  
 }  
794    
795  package SubsystemO;  =head3 type
796    
797  use Data::Dumper;  =over 4
 use Subsystem;  
798    
799  sub new {  =item USAGE:
     my($class,$figO,$name) = @_;  
800    
801      my $self = {};  C<< my $feature_type = $feature->type(); >>
     $self->{_figO} = $figO;  
     $self->{_id} = $name;  
802    
803      return bless $self, $class;  =item RETURNS:
 }  
804    
805  sub id {  The feature object's "type" (e.g., "peg," "rna," etc.)
     my($self) = @_;  
806    
807      return $self->{_id};  =back
 }  
808    
809  sub usable {  =cut
810    
811    sub type {
812      my($self) = @_;      my($self) = @_;
813    
814      my $figO = $self->{_figO};      $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
815      my $fig  = $figO->{_fig};      return $1;
     return $fig->usable_subsystem($self->id);  
816  }  }
817    
 sub genomes {  
     my($self) = @_;  
818    
     my $figO = $self->{_figO};  
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
819    
820      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;  =head3 location
 }  
821    
822  sub roles {  =over 4
     my($self) = @_;  
823    
824      my $figO = $self->{_figO};  =item USAGE:
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
825    
826      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);  C<< my $loc = $feature->location(); >>
 }  
827    
828  sub curator {  =item RETURNS:
     my($self) = @_;  
829    
830      my $figO = $self->{_figO};  A string representing the feature object's location on the genome's DNA,
831      my $subO = $self->{_subO};  in SEED "tbl format" (i.e., "contig_beging_end").
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
832    
833      return $subO->get_curator;  =back
 }  
834    
835  sub variant {  =cut
     my($self,$genome) = @_;  
836    
837      my $figO = $self->{_figO};  sub location {
838      my $subO = $self->{_subO};      my($self) = @_;
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
839    
840      return $subO->get_variant_code_for_genome($genome->id);      my $fig = $self->{_figO}->{_fig};
841        return scalar $fig->feature_location($self->id);
842  }  }
843    
 sub pegs_in_cell {  
     my($self,$genome,$role) = @_;  
844    
845      my $figO = $self->{_figO};  =head3 contig
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
846    
847      return $subO->get_pegs_from_cell($genome->id,$role->id);  =over 4
 }  
848    
849  package FunctionalRoleO;  =item USAGE:
850    
851  use Data::Dumper;  C<< my $contig = $feature->contig(); >>
852    
853  sub new {  =item RETURNS:
     my($class,$figO,$fr) = @_;  
854    
855      my $self = {};  A "ContigO" object to access the contig data
856      $self->{_figO} = $figO;  for the contig the feature is on.
     $self->{_id} = $fr;  
     return bless $self, $class;  
 }  
857    
858  sub id {  =back
859    
860    =cut
861    
862    sub contig {
863      my($self) = @_;      my($self) = @_;
864    
865      return $self->{_id};      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    
 package FigFamO;  
871    
 use FigFams;  
 use FigFam;  
872    
873  sub new {  =head3 begin
     my($class,$figO,$id) = @_;  
874    
875      my $self = {};  =over 4
     $self->{_figO} = $figO;  
     $self->{_id} = $id;  
     return bless $self, $class;  
 }  
876    
877  sub id {  =item USAGE:
     my($self) = @_;  
878    
879      return $self->{_id};  C<< my $beg = $feature->begin(); >>
 }  
880    
881  sub function {  =item RETURNS:
     my($self) = @_;  
882    
883      my $fig  = $self->{_figO}->{_fig};  The numerical coordinate of the first base of the feature.
     my $famO = $self->{_famO};  
     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }  
884    
885      return $famO->family_function;  =back
 }  
886    
887  sub members {  =cut
     my($self) = @_;  
888    
889      my $figO = $self->{_figO};  sub begin {
890      my $fig  = $figO->{_fig};      my($self) = @_;
     my $famO = $self->{_famO};  
     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }  
891    
892      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      my $loc = $self->location;
893        return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
894  }  }
895    
 sub rep_seqs {  
     my($self) = @_;  
896    
     my $figO = $self->{_figO};  
     my $fig  = $figO->{_fig};  
     my $famO = $self->{_famO};  
     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }  
897    
898      return $famO->representatives;  =head3 end
 }  
899    
900  sub should_be_member {  =over 4
     my($self,$seq) = @_;  
901    
902      my $figO = $self->{_figO};  =item USAGE:
     my $fig  = $figO->{_fig};  
     my $famO = $self->{_famO};  
     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }  
903    
904      return $famO->should_be_member($seq);  C<< my $end = $feature->end(); >>
 }  
905    
906    =item RETURNS:
907    
908    The numerical coordinate of the last base of the feature.
909    
910  sub display {  =back
911    
912    =cut
913    
914    sub end {
915      my($self) = @_;      my($self) = @_;
916    
917      print join("\t",($self->id,$self->function)),"\n";      my $loc = $self->location;
918        return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
919  }  }
920    
921    
922    
923  package Attribute;  =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);
948        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 {
971        my($self) = @_;
972    
973        ($self->type eq "peg") || return undef;
974        my $fig = $self->{_figO}->{_fig};
975        my $fid = $self->id;
976        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 {
999        my($self) = @_;
1000    
1001        my $fig = $self->{_figO}->{_fig};
1002        my $fid = $self->id;
1003        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 {
1026        my($self) = @_;
1027    
1028        ($self->type eq "peg") || return ();
1029        my $figO = $self->{_figO};
1030        my $fig  = $figO->{_fig};
1031        my $peg1 = $self->id;
1032        my @coupled = ();
1033        foreach my $tuple ($fig->coupled_to($peg1))
1034        {
1035            my($peg2,$sc) = @$tuple;
1036            push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));
1037        }
1038        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 {
1060        my($self) = @_;
1061    
1062        my $figO = $self->{_figO};
1063        my $fig  = $figO->{_fig};
1064    
1065        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 {
1113        my($self) = @_;
1114        my $figO = $self->{_figO};
1115        my $fig  = $figO->{_fig};
1116    
1117        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 {
1143        my($self) = @_;
1144        my $figO = $self->{_figO};
1145        my($tmp_dir) = $figO->{_tmp_dir};
1146    
1147        if (! $self->possibly_truncated)
1148        {
1149            my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);
1150            if (my $sim = shift @sims)
1151            {
1152                my $peg2 = $sim->id2;
1153                my $ln1  = $sim->ln1;
1154                my $ln2  = $sim->ln2;
1155                my $b2   = $sim->b2;
1156                my $e2   = $sim->e2;
1157                my $adjL = 100 + (($b2-1) * 3);
1158                my $adjR = 100 + (($ln2 - $e2) * 3);
1159                if ($ln2 > (1.2 * $ln1))
1160                {
1161                    my $loc = $self->location;
1162                    if ($loc =~ /^(\S+)_(\d+)_(\d+)/)
1163                    {
1164                        my $contig = $1;
1165                        my $beg    = $2;
1166                        my $end = $3;
1167                        my $contigO = new ContigO($figO,$self->genome->id,$contig);
1168                        my $begA = &max(1,$beg - $adjL);
1169                        my $endA = &min($end+$adjR,$contigO->contig_length);
1170                        my $dna  = $contigO->dna_seq($begA,$endA);
1171                        open(TMP,">$tmp_dir/tmp_dna") || die "couild not open tmp_dna";
1172                        print TMP ">dna\n$dna\n";
1173                        close(TMP);
1174    
1175                        my $peg2O = new FeatureO($figO,$peg2);
1176                        my $prot  = $peg2O->prot_seq;
1177                        open(TMP,">$tmp_dir/tmp_prot") || die "could not open tmp_prot";
1178                        print TMP ">tmp_prot\n$prot\n";
1179                        close(TMP);
1180                        &run("formatdb -i $tmp_dir/tmp_dna -pF");
1181                        open(BLAST,"blastall -i $tmp_dir/tmp_prot -d $tmp_dir/tmp_dna -p tblastn -FF -e 1.0e-50 |")
1182                            || die "could not blast";
1183    
1184                        my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);
1185                        my @hsps       = sort { $a->[0] <=> $b->[0] }
1186                                         map { [$_->[9],$_->[10],$_->[12],$_->[13]] }
1187                                         grep { $_->[1] < 1.0e-50 }
1188                                         @{$db_seq_out->[6]};
1189                        my @prot = map { [$_->[0],$_->[1]] } @hsps;
1190                        my @dna  = map { [$_->[2],$_->[3]] } @hsps;
1191                        if (&covers(\@prot,length($prot),3,0) && &covers(\@dna,3*length($prot),9,1))
1192                        {
1193                            return 1;
1194                        }
1195                    }
1196                }
1197            }
1198        }
1199        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 {
1228        my($cmd) = @_;
1229        (system($cmd) == 0) || Confess("FAILED: $cmd");
1230    }
1231    
1232    
1233    
1234    =head3 max
1235    
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;
1316        my $hsp2;
1317        my $merged = 0;
1318        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 {
1340        my($hsp1,$hsp2,$diff) = @_;
1341    
1342        my($b1,$e1) = @$hsp1;
1343        my($b2,$e2) = @$hsp2;
1344        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;
1370    sub sims {
1371        my($self,%args) = @_;
1372    
1373        my $figO = $self->{_figO};
1374        my $fig  = $figO->{_fig};
1375    
1376        my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
1377        my $all    = $args{-all}    ? $args{-all}    : "fig";
1378        my $max    = $args{-max}    ? $args{-max}    : 10000;
1379    
1380        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 {
1405        my($self) = @_;
1406    
1407        my $figO = $self->{_figO};
1408        my $fig  = $figO->{_fig};
1409    
1410        my @bbhs  = $fig->bbhs($self->id);
1411        return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
1412                                                      _peg1 => $self->id,
1413                                                      _peg2 => $peg2,
1414                                                      _psc => $sc,
1415                                                      _bit_score => $bs
1416                                                    },'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 {
1430        my($self) = @_;
1431    
1432        print join("\t",$self->id,$self->location,$self->function_of),"\n",
1433              $self->dna_seq,"\n",
1434              $self->prot_seq,"\n";
1435    }
1436    
1437    
1438    
1439    ########################################################################
1440    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 {
1459        my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
1460    
1461        my $self = {};
1462        $self->{_figO}      = $figO;
1463        $self->{_peg1}      = $peg1;
1464        $self->{_peg2}      = $peg2;
1465        $self->{_psc}       = $sc;
1466        $self->{_bit_score} = $normalized_bitscore
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 {
1490        my($self) = @_;
1491    
1492        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 {
1514        my($self) = @_;
1515    
1516        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 {
1539        my($self) = @_;
1540    
1541        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 {
1564        my($self) = @_;
1565    
1566        return $self->{_bit_score};
1567    }
1568    
1569    
1570    
1571    ########################################################################
1572    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 {
1588        my($class,$fid,$timestamp,$who,$text) = @_;
1589    
1590        my $self = {};
1591        $self->{_fid} = $fid;
1592        $self->{_timestamp} = $timestamp;
1593        $self->{_who} = $who;
1594        $self->{_text} = $text;
1595        return bless $self, $class;
1596    }
1597    
1598    
1599    
1600    =head3 fid
1601    
1602    =cut
1603    
1604    sub fid {
1605        my($self) = @_;
1606    
1607        return $self->{_fid};
1608    }
1609    
1610    
1611    
1612    =head3 timestamp
1613    
1614    =cut
1615    
1616    sub timestamp {
1617        my($self,$convert) = @_;
1618    
1619        if ($convert)
1620        {
1621            return scalar localtime($self->{_timestamp});
1622        }
1623        else
1624        {
1625            return $self->{_timestamp};
1626        }
1627    }
1628    
1629    
1630    
1631    =head3 made_by
1632    
1633    =cut
1634    
1635    sub made_by {
1636        my($self) = @_;
1637    
1638        my $who = $self->{_who};
1639        $who =~ s/^master://i;
1640        return $who;
1641    }
1642    
1643    
1644    
1645    =head3 text
1646    
1647    =cut
1648    
1649    sub text {
1650        my($self) = @_;
1651    
1652        my $text = $self->{_text};
1653        return $text;
1654    }
1655    
1656    
1657    =head3 display
1658    
1659    =cut
1660    
1661    sub display {
1662        my($self) = @_;
1663    
1664        print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1665    }
1666    
1667    
1668    
1669    ########################################################################
1670    package CouplingO;
1671    ########################################################################
1672    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 {
1688        my($class,$figO,$peg1,$peg2,$sc) = @_;
1689    
1690        ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1691        ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1692        my $self = {};
1693        $self->{_figO} = $figO;
1694        $self->{_peg1} = $peg1;
1695        $self->{_peg2} = $peg2;
1696        $self->{_sc}   = $sc;
1697        return bless $self, $class;
1698    }
1699    
1700    
1701    
1702    =head3 peg1
1703    
1704    =cut
1705    
1706    sub peg1 {
1707        my($self) = @_;
1708    
1709        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 {
1720        my($self) = @_;
1721    
1722        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 {
1733        my($self) = @_;
1734    
1735        return $self->{_sc};
1736    }
1737    
1738    
1739    
1740    =head3 evidence
1741    
1742    =cut
1743    
1744    sub evidence {
1745        my($self) = @_;
1746    
1747        my $figO = $self->{_figO};
1748        my $fig  = $figO->{_fig};
1749        my @ev = ();
1750        foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))
1751        {
1752            my($peg3,$peg4,$rep) = @$tuple;
1753            push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
1754                      &FeatureO::new('FeatureO',$figO,$peg4),
1755                      $rep]);
1756        }
1757        return @ev;
1758    }
1759    
1760    
1761    
1762    =head3 display
1763    
1764    =cut
1765    
1766    sub display {
1767        my($self) = @_;
1768    
1769        print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1770    }
1771    
1772    
1773    
1774    ########################################################################
1775    package SubsystemO;
1776    ########################################################################
1777    use Data::Dumper;
1778    use Subsystem;
1779    
1780    =head1 SubsystemO
1781    
1782    =cut
1783    
1784    
1785    
1786    =head3 new
1787    
1788    =cut
1789    
1790    sub new {
1791        my($class,$figO,$name) = @_;
1792    
1793        my $self = {};
1794        $self->{_figO} = $figO;
1795        $self->{_id} = $name;
1796    
1797        return bless $self, $class;
1798    }
1799    
1800    
1801    
1802    =head3 id
1803    
1804    =cut
1805    
1806    sub id {
1807        my($self) = @_;
1808    
1809        return $self->{_id};
1810    }
1811    
1812    
1813    
1814    =head3 usable
1815    
1816    
1817    =cut
1818    
1819    sub usable {
1820        my($self) = @_;
1821    
1822        my $figO = $self->{_figO};
1823        my $fig  = $figO->{_fig};
1824        return $fig->usable_subsystem($self->id);
1825    }
1826    
1827    
1828    
1829    =head3 genomes
1830    
1831    =cut
1832    
1833    sub genomes {
1834        my($self) = @_;
1835    
1836        my $figO = $self->{_figO};
1837        my $subO = $self->{_subO};
1838        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1839    
1840        return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1841    }
1842    
1843    
1844    
1845    =head3 roles
1846    
1847    =cut
1848    
1849    sub roles {
1850        my($self) = @_;
1851    
1852        my $figO = $self->{_figO};
1853        my $subO = $self->{_subO};
1854        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1855    
1856        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 {
1866        my($self) = @_;
1867    
1868        my $figO = $self->{_figO};
1869        my $subO = $self->{_subO};
1870        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1871    
1872        return $subO->get_curator;
1873    }
1874    
1875    
1876    
1877    
1878    =head3 variant
1879    
1880    =cut
1881    
1882    sub variant {
1883        my($self,$genome) = @_;
1884    
1885        my $figO = $self->{_figO};
1886        my $subO = $self->{_subO};
1887        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1888    
1889        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 {
1899        my($self,$genome,$role) = @_;
1900    
1901        my $figO = $self->{_figO};
1902        my $subO = $self->{_subO};
1903        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1904    
1905        return $subO->get_pegs_from_cell($genome->id,$role->id);
1906    }
1907    
1908    
1909    
1910    ########################################################################
1911    package FunctionalRoleO;
1912    ########################################################################
1913    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 {
1927        my($class,$figO,$fr) = @_;
1928    
1929        my $self = {};
1930        $self->{_figO} = $figO;
1931        $self->{_id} = $fr;
1932        return bless $self, $class;
1933    }
1934    
1935    
1936    
1937    =head3 id
1938    
1939    =cut
1940    
1941    sub id {
1942        my($self) = @_;
1943    
1944        return $self->{_id};
1945    }
1946    
1947    
1948    
1949    ########################################################################
1950    package FigFamO;
1951    ########################################################################
1952    use FigFams;
1953    use FigFam;
1954    
1955    
1956    =head1 FigFamO
1957    
1958    =cut
1959    
1960    
1961    =head3 new
1962    
1963    =cut
1964    
1965    sub new {
1966        my($class,$figO,$id) = @_;
1967    
1968        my $self = {};
1969        $self->{_figO} = $figO;
1970        $self->{_id} = $id;
1971        return bless $self, $class;
1972    }
1973    
1974    
1975    
1976    =head3 id
1977    
1978    =cut
1979    
1980    sub id {
1981        my($self) = @_;
1982    
1983        return $self->{_id};
1984    }
1985    
1986    
1987    =head3 function
1988    
1989    =cut
1990    
1991    sub function {
1992        my($self) = @_;
1993    
1994        my $fig  = $self->{_figO}->{_fig};
1995        my $famO = $self->{_famO};
1996        if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1997    
1998        return $famO->family_function;
1999    }
2000    
2001    
2002    
2003    =head3 members
2004    
2005    =cut
2006    
2007    sub members {
2008        my($self) = @_;
2009    
2010        my $figO = $self->{_figO};
2011        my $fig  = $figO->{_fig};
2012        my $famO = $self->{_famO};
2013        if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2014    
2015        return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2016    }
2017    
2018    =head3 rep_seqs
2019    
2020    =cut
2021    
2022    sub rep_seqs {
2023        my($self) = @_;
2024    
2025        my $figO = $self->{_figO};
2026        my $fig  = $figO->{_fig};
2027        my $famO = $self->{_famO};
2028        if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2029    
2030        return $famO->representatives;
2031    }
2032    
2033    
2034    
2035    =head3 should_be_member
2036    
2037    =cut
2038    
2039    sub should_be_member {
2040        my($self,$seq) = @_;
2041    
2042        my $figO = $self->{_figO};
2043        my $fig  = $figO->{_fig};
2044        my $famO = $self->{_famO};
2045        if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2046    
2047        return $famO->should_be_member($seq);
2048    }
2049    
2050    
2051    
2052    =head3 display
2053    
2054    =cut
2055    
2056    sub display {
2057        my($self) = @_;
2058    
2059        print join("\t",($self->id,$self->function)),"\n";
2060    }
2061    
2062    
2063    
2064    ########################################################################
2065    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.1  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3