[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.31, Sat Dec 1 22:17:03 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 TODO
21    
22    =over 4
23    
24    =item Null arg to ContigO::dna_seq() should return entire contig seq.
25    
26    =item Add method to access "FIG::crude_estimate_of_distance()"
27    
28    =back
29    
30    =cut
31    
32    =head1 Overview
33    
34    This module is a set of packages encapsulating the SEED's core methods
35    using an "OOP-like" style.
36    
37    There are several modules clearly related to "individual genomes:"
38    GenomeO, ContigO, FeatureO (and I<maybe> AnnotationO).
39    
40    There are also modules that deal with complex relationships between
41    pairs or sets of features in one, two, or more genomes,
42    rather than any particular single genome:
43    BBHO, CouplingO, SubsystemO, FunctionalRoleO, FigFamO.
44    
45    Finally, the methods in "Attribute" might in principle attach
46    "atributes" to any type of object.
47    (Likewise, in principle one might also want to attach an "annotation"
48    to any type of object,
49    although currently we only support annotations of "features.")
50    
51    The three modules that act on "individual genomes" have a reasonable clear
52    "implied heirarchy" relative to FIGO:
53    
54    =over 4
55    
56        FIGO > GenomeO > ContigO > FeatureO
57    
58    =back
59    
60    However, inheritance is B<NOT> implemented using the C<@ISA> mechanism,
61    because some methods deal with "pairwise" or "setwise" relations between objects
62    or other more complex relationships that do not naturally fit into any heirarchy ---
63    which would get us into the whole quagmire of "multiple inheritance."
64    
65    We have chosen to in many cases sidestep the entire issue of inheritance
66    via an I<ad hoc> mechanism:
67    If a "child" object needs access to its "ancestors'" methods,
68    we will explicitly pass it references to its "ancestors,"
69    as subroutine arguments.
70    This is admittedly ugly, clumsy, and potentially error-prone ---
71    but it has the advantage that, unlike multiple inheritance,
72    we understand how to do it...
73    
74    MODULE DEPENDENCIES: FIG, FIG_Config, FigFams, SFXlate, SproutFIG, Tracer,
75        gjoparseblast, Data::Dumper.
76    
77    =cut
78    
79    ########################################################################
80    package FIGO;
81    ########################################################################
82  use strict;  use strict;
83  use FIG;  use FIG;
84  use FIG_Config;  use FIG_Config;
# Line 24  Line 86 
86  use SproutFIG;  use SproutFIG;
87  use Tracer;  use Tracer;
88  use Data::Dumper;  use Data::Dumper;
89    use Carp;
90  use FigFams;  use FigFams;
91    use gjoparseblast;
92    
93    =head1 FIGO
94    
95    The effective "base class" containing a few "top-level" methods.
96    
97    =cut
98    
99    
100    =head3 new
101    
102    Constructs a new FIGO object.
103    
104    =over 4
105    
106    =item USAGE:
107    
108    C<< my $figo = FIGO->new();           #...Subclass defaults to FIG >>
109    
110    C<< my $figo = FIGO->new('SPROUT');   #...Subclass is a SPROUT object >>
111    
112    =back
113    
114    =cut
115    
116  sub new {  sub new {
117      my($class,$low_level) = @_;      my($class,$low_level) = @_;
# Line 41  Line 128 
128    
129      my $self = {};      my $self = {};
130      $self->{_fig} = $fig;      $self->{_fig} = $fig;
131        $self->{_tmp_dir} = $FIG_Config::temp;
132      return bless $self, $class;      return bless $self, $class;
133  }  }
134    
135    sub function_of {
136        my($self,$id) = @_;
137    
138        my $fig  = $self->{_fig};
139        my $func = $fig->function_of($id);
140    
141        return ($func ? $func : "");
142    }
143    
144    =head3 genomes
145    
146    Returns a list of Taxonomy-IDs, possibly constrained by selection criteria.
147    (Default: Empty constraint returns all Tax-IDs in the SEED or SPROUT.)
148    
149    =over 4
150    
151    =item USAGE:
152    
153    C<< my @tax_ids = $figo->genomes(); >>
154    
155    C<< my @tax_ids = $figo->genomes( @constraints ); >>
156    
157    =item @constraints
158    
159    One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
160    
161    =item RETURNS: List of Tax-IDs.
162    
163    =item EXAMPLE:
164    
165    L<Display all complete, prokaryotic genomes>
166    
167    =back
168    
169    =cut
170    
171  sub genomes {  sub genomes {
172      my($self,@constraints) = @_;      my($self,@constraints) = @_;
173      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 88  Line 212 
212      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
213  }  }
214    
215    
216    
217    =head3 subsystems
218    
219    =over 4
220    
221    =item RETURNS:
222    
223    List of all subsystems.
224    
225    =item EXAMPLE:
226    
227    L<Accessing Subsystem data>
228    
229    =back
230    
231    =cut
232    
233  sub subsystems {  sub subsystems {
234      my($self) = @_;      my($self) = @_;
235      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 95  Line 237 
237      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
238  }  }
239    
240    
241    =head3 functional_roles
242    
243    (Not yet implemented)
244    
245    =over
246    
247    =item RETURNS:
248    
249    =item EXAMPLE:
250    
251    =back
252    
253    =cut
254    
255  sub functional_roles {  sub functional_roles {
256      my($self) = @_;      my($self) = @_;
257      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 104  Line 261 
261      return @functional_roles;      return @functional_roles;
262  }  }
263    
264    
265    
266    =head3 all_figfams
267    
268    Returns a list of all FIGfam objects.
269    
270    =over 4
271    
272    =item USAGE:
273    
274    C<< foreach $fam ($figO->all_figfams) { #...Do something } >>
275    
276    =item RETURNS:
277    
278    List of FIGfam Objects
279    
280    =item EXAMPLE:
281    
282    L<Accessing FIGfams>
283    
284    =back
285    
286    =cut
287    
288  sub all_figfams {  sub all_figfams {
289      my($self) = @_;      my($self) = @_;
290      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 111  Line 292 
292      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
293  }  }
294    
295    
296    
297    =head3 family_containing
298    
299    =over 4
300    
301    =item USAGE:
302    
303    C<< my ($fam, $sims) = $figO->family_containing($seq); >>
304    
305    =item $seq:
306    
307    A protein translation string.
308    
309    =item RETURNS:
310    
311    $fam:  A FIGfam Object.
312    
313    $sims: A set of similarity objects.
314    
315    =item EXAMPLE: L<Placing a sequence into a FIGfam>
316    
317    =back
318    
319    =cut
320    
321  sub family_containing {  sub family_containing {
322      my($self,$seq) = @_;      my($self,$seq) = @_;
323    
# Line 127  Line 334 
334      }      }
335  }  }
336    
337  package GenomeO;  =head3 figfam
338    
339    =over 4
340    
341    =item USAGE:
342    
343    C<< my $fam = $figO->figfam($family_id); >>
344    
345    =item $family_id;
346    
347    A FigFam ID
348    
349    =item RETURNS:
350    
351    $fam:  A FIGfam Object.
352    
353    =back
354    
355    =cut
356    
357    sub figfam {
358        my($self,$fam_id) = @_;
359    
360        return &FigFamO::new('FigFamO',$self,$fam_id);
361    }
362    
363    
364    ########################################################################
365    package GenomeO;
366    ########################################################################
367  use Data::Dumper;  use Data::Dumper;
368    
369    =head1 GenomeO
370    
371    =cut
372    
373    
374    =head3 new
375    
376    Constructor of GenomeO objects.
377    
378    =over 4
379    
380    =item USAGE:
381    
382    C<< my $orgO = GenomeO->new($figO, $tax_id); >>
383    
384    =item RETURNS:
385    
386    A new "GenomeO" object.
387    
388    =back
389    
390    =cut
391    
392  sub new {  sub new {
393      my($class,$figO,$genomeId) = @_;      my($class,$figO,$genomeId) = @_;
394    
# Line 140  Line 398 
398      return bless $self, $class;      return bless $self, $class;
399  }  }
400    
401    
402    
403    =head3 id
404    
405    =over 4
406    
407    =item USAGE:
408    
409    C<< my $tax_id = $orgO->id(); >>
410    
411    =item RETURNS:
412    
413    Taxonomy-ID of "GenomeO" object.
414    
415    =back
416    
417    =cut
418    
419  sub id {  sub id {
420      my($self) = @_;      my($self) = @_;
421    
422      return $self->{_id};      return $self->{_id};
423  }  }
424    
425    
426    
427    =head3 genus_species
428    
429    =over 4
430    
431    =item USAGE:
432    
433    C<< $gs = $orgO->genus_species(); >>
434    
435    =item RETURNS:
436    
437    Genus-species-strain string
438    
439    =back
440    
441    =cut
442    
443  sub genus_species {  sub genus_species {
444      my($self) = @_;      my($self) = @_;
445    
# Line 153  Line 447 
447      return $fig->genus_species($self->{_id});      return $fig->genus_species($self->{_id});
448  }  }
449    
450    
451    
452    
453    =head3 taxonomy_of
454    
455    =over 4
456    
457    =item FUNCTION:
458    
459    Return the TAXONOMY string of a "GenomeO" object.
460    
461    =item USAGE:
462    
463    C<< my $taxonomy = $orgO->taxonomy_of(); >>
464    
465    =item RETURNS:
466    
467    TAXONOMY string.
468    
469    =back
470    
471    =cut
472    
473    sub taxonomy_of {
474        my ($self) = @_;
475    
476        my $figO = $self->{_figO};
477        my $fig  = $figO->{_fig};
478    
479        return $fig->taxonomy_of($self->{_id});
480    }
481    
482    
483    =head3 contigs_of
484    
485    =over 4
486    
487    =item RETURNS:
488    
489    List of C<contig> objects contained in a C<GenomeO> object.
490    
491    =item EXAMPLE:
492    
493    L<Show how to access contigs and extract sequence>
494    
495    =back
496    
497    =cut
498    
499  sub contigs_of {  sub contigs_of {
500      my($self) = @_;      my($self) = @_;
501    
# Line 161  Line 504 
504      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);
505  }  }
506    
507    
508    
509    =head3 features_of
510    
511    =over 4
512    
513    =item FUNCTION:
514    
515    Returns a list of "FeatureO" objects contained in a "GenomeO" object.
516    
517    =item USAGE:
518    
519    C<< my @featureOs = $orgO->features_of();        #...Fetch all features >>
520    
521    or
522    
523    C<< my @featureOs = $orgO->features_of('peg');   #...Fetch only PEGs >>
524    
525    =item RETURNS:
526    
527    List of "FeatureO" objects.
528    
529    =back
530    
531    =cut
532    
533  sub features_of {  sub features_of {
534      my($self,$type) = @_;      my($self,$type) = @_;
535    
# Line 170  Line 539 
539      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
540  }  }
541    
542    
543    =head3 display
544    
545    Prints the genus, species, and strain information about a genome to STDOUT.
546    
547    =over 4
548    
549    =item USAGE:
550    
551    C<< $genome->display(); >>
552    
553    =item RETURNS:
554    
555    (Void)
556    
557    =back
558    
559    =cut
560    
561  sub display {  sub display {
562      my($self) = @_;      my($self) = @_;
563    
564      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
565  }  }
566    
 package ContigO;  
567    
568    
569    ########################################################################
570    package ContigO;
571    ########################################################################
572  use Data::Dumper;  use Data::Dumper;
573    
574    =head1 ContigO
575    
576    Methods for working with DNA sequence objects.
577    
578    =cut
579    
580    =head3 new
581    
582    Contig constructor.
583    
584    =over 4
585    
586    =item USAGE:
587    
588    C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>
589    
590    =item $figO:
591    
592    Parent FIGO object.
593    
594    =item $genomeId:
595    
596    Taxon-ID for the genome the contig is from.
597    
598    =item $contigId:
599    
600    Identifier for the contig
601    
602    =item RETURNS:
603    
604    A "ContigO" object.
605    
606    =back
607    
608    =cut
609    
610  sub new {  sub new {
611      my($class,$figO,$genomeId,$contigId) = @_;      my($class,$figO,$genomeId,$contigId) = @_;
612    
# Line 190  Line 617 
617      return bless $self, $class;      return bless $self, $class;
618  }  }
619    
620    
621    
622    =head3 id
623    
624    =over 4
625    
626    =item RETURNS:
627    
628    Sequence ID string of "ContigO" object
629    
630    =back
631    
632    =cut
633    
634  sub id {  sub id {
635      my($self) = @_;      my($self) = @_;
636    
637      return $self->{_id};      return $self->{_id};
638  }  }
639    
 sub genome {  
     my($self) = @_;  
640    
641      return $self->{_genome};  =head3 genome
 }  
642    
643  sub contig_length {  =over 4
     my($self) = @_;  
644    
645      my $fig = $self->{_figO}->{_fig};  =item USAGE:
     my $contig_lengths = $fig->contig_lengths($self->genome);  
     return $contig_lengths->{$self->id};  
 }  
646    
647  sub dna_seq {  C<< my $tax_id = $contig->genome->id(); >>
     my($self,$beg,$end) = @_;  
648    
649      my $fig = $self->{_figO}->{_fig};  =item RETURNS:
     my $max = $self->contig_length;  
     if (($beg && (&FIG::between(1,$beg,$max))) &&  
         ($end && (&FIG::between(1,$end,$max))))  
     {  
         return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));  
     }  
     else  
     {  
         return undef;  
     }  
 }  
650    
651  sub display {  Tax-ID of the GenomeO object containing the contig object.
652    
653    =back
654    
655    =cut
656    
657    sub genome {
658      my($self) = @_;      my($self) = @_;
659    
660      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";      my $figO = $self->{_figO};
661        return new GenomeO($figO,$self->{_genome});
662  }  }
663    
 package FeatureO;  
664    
 use Data::Dumper;  
665    
666  sub new {  =head3 contig_length
     my($class,$figO,$fid) = @_;  
667    
668      ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;  =over 4
     my $self = {};  
     $self->{_figO} = $figO;  
     $self->{_id} = $fid;  
     return bless $self, $class;  
 }  
   
 sub id {  
     my($self) = @_;  
   
     return $self->{_id};  
 }  
   
 sub genome {  
     my($self) = @_;  
   
     $self->id =~ /^fig\|(\d+\.\d+)/;  
     return $1;  
 }  
669    
670  sub type {  =item USAGE:
     my($self) = @_;  
671    
672      $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;  C<< my $len = $contig->contig_length(); >>
     return $1;  
 }  
673    
674  sub location {  =item RETURNS:
     my($self) = @_;  
675    
676      my $fig = $self->{_figO}->{_fig};  Length of contig's DNA sequence.
     return scalar $fig->feature_location($self->id);  
 }  
677    
678  sub dna_seq {  =back
     my($self) = @_;  
679    
680      my $fig = $self->{_figO}->{_fig};  =cut
     my $fid = $self->id;  
     my @loc = $fig->feature_location($fid);  
     return $fig->dna_seq(&FIG::genome_of($fid),@loc);  
 }  
681    
682  sub prot_seq {  sub contig_length {
683      my($self) = @_;      my($self) = @_;
684    
     ($self->type eq "peg") || return undef;  
685      my $fig = $self->{_figO}->{_fig};      my $fig = $self->{_figO}->{_fig};
686      my $fid = $self->id;      my $contig_lengths = $fig->contig_lengths($self->genome->id);
687      return $fig->get_translation($fid);      return $contig_lengths->{$self->id};
688  }  }
689    
 sub function_of {  
     my($self) = @_;  
   
     my $fig = $self->{_figO}->{_fig};  
     my $fid = $self->id;  
     return scalar $fig->function_of($fid);  
 }  
690    
691  sub coupled_to {  =head3 dna_seq
     my($self) = @_;  
692    
693      ($self->type eq "peg") || return undef;  =over 4
     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;  
 }  
694    
695  sub annotations {  =item USAGE:
     my($self) = @_;  
696    
697      my $figO = $self->{_figO};  C<< my $seq = $contig->dna_seq(beg, $end); >>
     my $fig  = $figO->{_fig};  
698    
699      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);  =item $beg:
 }  
700    
701  sub display {  Begining point of DNA subsequence
     my($self) = @_;  
702    
703      print join("\t",$self->id,$self->location,$self->function_of),"\n",  =item $end:
           $self->dna_seq,"\n",  
           $self->prot_seq,"\n";  
 }  
704    
705  package AnnotationO;  End point of DNA subsequence
706    
707  sub new {  =item RETURNS:
     my($class,$fid,$timestamp,$who,$text) = @_;  
708    
709      my $self = {};  String containing DNA subsequence running from $beg to $end
710      $self->{_fid} = $fid;  (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
     $self->{_timestamp} = $timestamp;  
     $self->{_who} = $who;  
     $self->{_text} = $text;  
     return bless $self, $class;  
 }  
711    
712  sub fid {  =back
     my($self) = @_;  
713    
714      return $self->{_fid};  =cut
 }  
715    
716  sub timestamp {  sub dna_seq {
717      my($self,$convert) = @_;      my($self,$beg,$end) = @_;
718    
719      if ($convert)      my $fig = $self->{_figO}->{_fig};
720        my $max = $self->contig_length;
721        if (($beg && (&FIG::between(1,$beg,$max))) &&
722            ($end && (&FIG::between(1,$end,$max))))
723      {      {
724          return scalar localtime($self->{_timestamp});          return $fig->dna_seq($self->genome->id,join("_",($self->id,$beg,$end)));
725      }      }
726      else      else
727      {      {
728          return $self->{_timestamp};          return undef;
729      }      }
730  }  }
731    
 sub made_by {  
     my($self) = @_;  
   
     my $who = $self->{_who};  
     $who =~ s/^master://i;  
     return $who;  
 }  
732    
733  sub text {  =head3 display
     my($self) = @_;  
734    
735      my $text = $self->{_text};  Prints summary information about a "ContigO" object to STDOUT:
     return $text;  
 }  
736    
737  sub display {  Genus, species, strain
     my($self) = @_;  
738    
739      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";  Contig ID
 }  
740    
741  package CouplingO;  Contig length
742    
743  use Data::Dumper;  =over 4
744    
745  sub new {  =item RETURNS:
     my($class,$figO,$peg1,$peg2,$sc) = @_;  
746    
747      ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;  (Void)
     ($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;  
 }  
748    
749  sub peg1 {  =back
     my($self) = @_;  
750    
751      return $self->{_peg1};  =cut
 }  
752    
753  sub peg2 {  sub display {
754      my($self) = @_;      my($self) = @_;
755    
756      return $self->{_peg2};      print join("ContigO",$self->genome->id,$self->id,$self->contig_length),"\n";
757  }  }
758    
759  sub sc {  sub features_in_region {
760      my($self) = @_;      my($self,$beg,$end) = @_;
761        my $figO = $self->{_figO};
762        my $fig = $figO->{_fig};
763    
764      return $self->{_sc};      my($features) = $fig->genes_in_region($self->genome->id,$self->id,$beg,$end);
765        return map { new FeatureO($figO,$_) } @$features;
766  }  }
767    
 sub evidence {  
     my($self) = @_;  
768    
     my $figO = $self->{_figO};  
     my $fig  = $figO->{_fig};  
     my @ev = ();  
     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;  
 }  
769    
770  sub display {  ########################################################################
771      my($self) = @_;  package FeatureO;
772    ########################################################################
773    use Data::Dumper;
774    use Carp;
775    
776      print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";  =head1 FeatureO
 }  
777    
778  package SubsystemO;  Methods for working with features on "ContigO" objects.
779    
780  use Data::Dumper;  =cut
 use Subsystem;  
781    
 sub new {  
     my($class,$figO,$name) = @_;  
782    
783      my $self = {};  =head3 new
     $self->{_figO} = $figO;  
     $self->{_id} = $name;  
784    
785      return bless $self, $class;  Constructor of new "FeatureO" objects
 }  
786    
787  sub id {  =over 4
     my($self) = @_;  
788    
789      return $self->{_id};  =item USAGE:
 }  
790    
791  sub usable {  C<< my $feature = FeatureO->new( $figO, $fid ); >>
     my($self) = @_;  
792    
793      my $figO = $self->{_figO};  =item C<$figO>:
     my $fig  = $figO->{_fig};  
     return $fig->usable_subsystem($self->id);  
 }  
794    
795  sub genomes {  "Base" FIGO object.
     my($self) = @_;  
796    
797      my $figO = $self->{_figO};  =item C<$fid>:
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
798    
799      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;  Feature-ID for new feature
 }  
800    
801  sub roles {  =item RETURNS:
     my($self) = @_;  
802    
803      my $figO = $self->{_figO};  A newly created "FeatureO" object.
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
804    
805      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);  =back
 }  
806    
807  sub curator {  =cut
     my($self) = @_;  
808    
809      my $figO = $self->{_figO};  sub new {
810      my $subO = $self->{_subO};      my($class,$figO,$fid) = @_;
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
811    
812      return $subO->get_curator;      ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
813        my $self = {};
814        $self->{_figO} = $figO;
815        $self->{_id} = $fid;
816        return bless $self, $class;
817  }  }
818    
 sub variant {  
     my($self,$genome) = @_;  
819    
     my $figO = $self->{_figO};  
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
820    
821      return $subO->get_variant_code_for_genome($genome->id);  =head3 id
 }  
822    
823  sub pegs_in_cell {  =over 4
     my($self,$genome,$role) = @_;  
824    
825      my $figO = $self->{_figO};  =item USAGE:
     my $subO = $self->{_subO};  
     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }  
826    
827      return $subO->get_pegs_from_cell($genome->id,$role->id);  C<< my $fid = $feature->id(); >>
 }  
828    
829  package FunctionalRoleO;  =item RETURNS:
830    
831  use Data::Dumper;  The FID (Feature ID) of a "FeatureO" object.
832    
833  sub new {  =back
     my($class,$figO,$fr) = @_;  
834    
835      my $self = {};  =cut
     $self->{_figO} = $figO;  
     $self->{_id} = $fr;  
     return bless $self, $class;  
 }  
836    
837  sub id {  sub id {
838      my($self) = @_;      my($self) = @_;
# Line 540  Line 840 
840      return $self->{_id};      return $self->{_id};
841  }  }
842    
 package FigFamO;  
843    
 use FigFams;  
 use FigFam;  
844    
845  sub new {  =head3 genome
     my($class,$figO,$id) = @_;  
846    
847      my $self = {};  =over 4
     $self->{_figO} = $figO;  
     $self->{_id} = $id;  
     return bless $self, $class;  
 }  
848    
849  sub id {  =item USAGE:
     my($self) = @_;  
850    
851      return $self->{_id};  C<< my $taxid = $feature->genome(); >>
 }  
852    
853  sub function {  =item RETURNS:
     my($self) = @_;  
854    
855      my $fig  = $self->{_figO}->{_fig};  The Taxon-ID for the "GenomeO" object containing the feature.
     my $famO = $self->{_famO};  
     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }  
856    
857      return $famO->family_function;  =back
 }  
858    
859  sub members {  =cut
     my($self) = @_;  
860    
861    sub genome {
862        my($self) = @_;
863      my $figO = $self->{_figO};      my $figO = $self->{_figO};
864      my $fig  = $figO->{_fig};      $self->id =~ /^fig\|(\d+\.\d+)/;
865        return new GenomeO($figO,$1);
866    }
867    
868    
869    
870    =head3 type
871    
872    =over 4
873    
874    =item USAGE:
875    
876    C<< my $feature_type = $feature->type(); >>
877    
878    =item RETURNS:
879    
880    The feature object's "type" (e.g., "peg," "rna," etc.)
881    
882    =back
883    
884    =cut
885    
886    sub type {
887        my($self) = @_;
888    
889        $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
890        return $1;
891    }
892    
893    
894    
895    =head3 location
896    
897    =over 4
898    
899    =item USAGE:
900    
901    C<< my $loc = $feature->location(); >>
902    
903    =item RETURNS:
904    
905    A string representing the feature object's location on the genome's DNA,
906    in SEED "tbl format" (i.e., "contig_beging_end").
907    
908    =back
909    
910    =cut
911    
912    sub location {
913        my($self) = @_;
914    
915        my $fig = $self->{_figO}->{_fig};
916        return scalar $fig->feature_location($self->id);
917    }
918    
919    
920    =head3 contig
921    
922    =over 4
923    
924    =item USAGE:
925    
926    C<< my $contig = $feature->contig(); >>
927    
928    =item RETURNS:
929    
930    A "ContigO" object to access the contig data
931    for the contig the feature is on.
932    
933    =back
934    
935    =cut
936    
937    sub contig {
938        my($self) = @_;
939    
940        my $figO = $self->{_figO};
941        my $loc      = $self->location;
942        my $genomeID = $self->genome->id;
943        return ($loc =~ /^(\S+)_\d+_\d+$/) ? new ContigO($figO,$genomeID,$1) : undef;
944    }
945    
946    
947    
948    =head3 begin
949    
950    =over 4
951    
952    =item USAGE:
953    
954    C<< my $beg = $feature->begin(); >>
955    
956    =item RETURNS:
957    
958    The numerical coordinate of the first base of the feature.
959    
960    =back
961    
962    =cut
963    
964    sub begin {
965        my($self) = @_;
966    
967        my $loc = $self->location;
968        return ($loc =~ /^\S+_(\d+)_\d+$/) ? $1 : undef;
969    }
970    
971    
972    
973    =head3 end
974    
975    =over 4
976    
977    =item USAGE:
978    
979    C<< my $end = $feature->end(); >>
980    
981    =item RETURNS:
982    
983    The numerical coordinate of the last base of the feature.
984    
985    =back
986    
987    =cut
988    
989    sub end {
990        my($self) = @_;
991    
992        my $loc = $self->location;
993        return ($loc =~ /^\S+_\d+_(\d+)$/) ? $1 : undef;
994    }
995    
996    
997    
998    =head3 dna_seq
999    
1000    =over 4
1001    
1002    =item USAGE:
1003    
1004    C<< my $dna_seq = $feature->dna_seq(); >>
1005    
1006    =item RETURNS:
1007    
1008    A string contining the DNA subsequence of the contig
1009    running from the first to the last base of the feature.
1010    
1011    If ($beg > $end), the reverse complement subsequence is returned.
1012    
1013    =back
1014    
1015    =cut
1016    
1017    sub dna_seq {
1018        my($self) = @_;
1019    
1020        my $fig = $self->{_figO}->{_fig};
1021        my $fid = $self->id;
1022        my @loc = $fig->feature_location($fid);
1023        return $fig->dna_seq(&FIG::genome_of($fid),@loc);
1024    }
1025    
1026    
1027    
1028    =head3 prot_seq
1029    
1030    =over 4
1031    
1032    =item USAGE:
1033    
1034    C<< my $dna_seq = $feature->prot_seq(); >>
1035    
1036    =item RETURNS:
1037    
1038    A string contining the protein translation of the feature (if it exists),
1039    or the "undef" value if the feature does not exist or is not a PEG.
1040    
1041    =back
1042    
1043    =cut
1044    
1045    sub prot_seq {
1046        my($self) = @_;
1047    
1048        ($self->type eq "peg") || return undef;
1049        my $fig = $self->{_figO}->{_fig};
1050        my $fid = $self->id;
1051        return $fig->get_translation($fid);
1052    }
1053    
1054    
1055    
1056    =head3 function_of
1057    
1058    =over 4
1059    
1060    =item USAGE:
1061    
1062    C<< my $func = $feature->function_of(); >>
1063    
1064    =item RETURNS:
1065    
1066    A string containing the function assigned to the feature,
1067    or the "undef" value if no function has been assigned.
1068    
1069    =back
1070    
1071    =cut
1072    
1073    sub function_of {
1074        my($self) = @_;
1075    
1076        my $fig = $self->{_figO}->{_fig};
1077        my $fid = $self->id;
1078        return scalar $fig->function_of($fid);
1079    }
1080    
1081    
1082    
1083    =head3 coupled_to
1084    
1085    =over 4
1086    
1087    =item USAGE:
1088    
1089    C<< my @coupled_features = $feature->coupled_to(); >>
1090    
1091    =item RETURNS:
1092    
1093    A list of "CouplingO" objects describing the evidence for functional coupling
1094    between this feature and other nearby features.
1095    
1096    =back
1097    
1098    =cut
1099    
1100    sub coupled_to {
1101        my($self) = @_;
1102    
1103        ($self->type eq "peg") || return ();
1104        my $figO = $self->{_figO};
1105        my $fig  = $figO->{_fig};
1106        my $peg1 = $self->id;
1107        my @coupled = ();
1108        foreach my $tuple ($fig->coupled_to($peg1))
1109        {
1110            my($peg2,$sc) = @$tuple;
1111            push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));
1112        }
1113        return @coupled;
1114    }
1115    
1116    
1117    
1118    =head3 annotations
1119    
1120    =over 4
1121    
1122    =item USAGE:
1123    
1124    C<< my @annot_list = $feature->annotations(); >>
1125    
1126    =item RETURNS:
1127    
1128    A list of "AnnotationO" objects allowing access to the annotations for this feature.
1129    
1130    =back
1131    
1132    =cut
1133    
1134    sub annotations {
1135        my($self) = @_;
1136    
1137        my $figO = $self->{_figO};
1138        my $fig  = $figO->{_fig};
1139    
1140        return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
1141    }
1142    
1143    
1144    =head3 in_subsystems
1145    
1146    =over 4
1147    
1148    =item USAGE:
1149    
1150    C<< my @subsys_list = $feature->in_subsystems(); >>
1151    
1152    =item RETURNS:
1153    
1154    A list of "SubsystemO" objects allowing access to the subsystems
1155    that this feature particupates in.
1156    
1157    =back
1158    
1159    =cut
1160    
1161    sub in_subsystems {
1162        my($self) = @_;
1163        my $figO = $self->{_figO};
1164        my $fig  = $figO->{_fig};
1165    
1166        return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);
1167    }
1168    
1169    
1170    =head3 possibly_truncated
1171    
1172    =over 4
1173    
1174    =item USAGE:
1175    
1176    C<< my $trunc = $feature->possibly_truncated(); >>
1177    
1178    =item RETURNS:
1179    
1180    Boolean C<TRUE> if the feature may be truncated;
1181    boolean C<FALSE> otherwise.
1182    
1183    =back
1184    
1185    =cut
1186    
1187    sub possibly_truncated {
1188        my($self) = @_;
1189        my $figO = $self->{_figO};
1190        my $fig  = $figO->{_fig};
1191    
1192        return $fig->possibly_truncated($self->id);
1193    }
1194    
1195    
1196    
1197    =head3 possible_frameshift
1198    
1199    =over 4
1200    
1201    =item USAGE:
1202    
1203    C<< my $fs = $feature->possible_frameshift(); >>
1204    
1205    =item RETURNS:
1206    
1207    Boolean C<TRUE> if the feature may be a frameshifted fragment;
1208    boolean C<FALSE> otherwise.
1209    
1210    (NOTE: This is a crude prototype implementation,
1211    and is mostly as an example of how to code using FIGO.)
1212    
1213    =back
1214    
1215    =cut
1216    
1217    sub possible_frameshift {
1218        my($self) = @_;
1219        my $figO = $self->{_figO};
1220        my $fig = $figO->{_fig};
1221    
1222        return $fig->possible_frameshift($self->id);
1223    }
1224    
1225    
1226    
1227    =head3 run
1228    
1229    (Note: This function should be considered "PRIVATE")
1230    
1231    =over 4
1232    
1233    =item FUNCTION:
1234    
1235    Passes a string containing a command to be execture by the "system" shell command.
1236    
1237    =item USAGE:
1238    
1239    C<< $feature->run($cmd); >>
1240    
1241    =item RETURNS:
1242    
1243    Nil if the execution of C<$cmd> was successful;
1244    aborts with traceback if C<$cmd> fails.
1245    
1246    =back
1247    
1248    =cut
1249    
1250    sub run {
1251        my($cmd) = @_;
1252        (system($cmd) == 0) || confess("FAILED: $cmd");
1253    }
1254    
1255    
1256    
1257    =head3 max
1258    
1259    (Note: This function should be considered "PRIVATE")
1260    
1261    =over 4
1262    
1263    =item USAGE:
1264    
1265    C<< my $max = $feature->max($x, $y); >>
1266    
1267    =item C<$x> and  C<$y>
1268    
1269    Numerical values.
1270    
1271    =item RETURNS:
1272    
1273    The larger of the two numerical values C<$x> and C<$y>.
1274    
1275    =back
1276    
1277    =cut
1278    
1279    sub max {
1280        my($x,$y) = @_;
1281        return ($x < $y) ? $y : $x;
1282    }
1283    
1284    
1285    
1286    =head3 min
1287    
1288    (Note: This function should be considered "PRIVATE")
1289    
1290    =over 4
1291    
1292    =item USAGE:
1293    
1294    C<< my $min = $feature->min($x, $y); >>
1295    
1296    =item C<$x> and C<$y>
1297    
1298    Numerical values.
1299    
1300    =item RETURNS:
1301    
1302    The smaller of the two numerical values C<$x> and C<$y>.
1303    
1304    =back
1305    
1306    =cut
1307    
1308    sub min {
1309        my($x,$y) = @_;
1310        return ($x < $y) ? $x : $y;
1311    }
1312    
1313    =head3 sims
1314    
1315    =over 4
1316    
1317    =item FUNCTION:
1318    
1319    Returns precomputed "Sim.pm" objects from the SEED.
1320    
1321    =item USAGE:
1322    
1323    C<< my @sims = $pegO->sims( -all, -cutoff => 1.0e-10); >>
1324    
1325    C<< my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10); >>
1326    
1327    =item RETURNS: List of sim objects.
1328    
1329    =back
1330    
1331    =cut
1332    
1333    use Sim;
1334    sub sims {
1335        my($self,%args) = @_;
1336    
1337        my $figO = $self->{_figO};
1338        my $fig  = $figO->{_fig};
1339    
1340        my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
1341        my $all    = $args{-all}    ? 'all'          : "fig";
1342        my $max    = $args{-max}    ? $args{-max}    : 10000;
1343    
1344        my @sims = $fig->sims($self->id,$max,$cutoff,$all);
1345    
1346        if (@sims) {
1347            my $peg1 = FeatureO->new($figO, $sims[0]->[0]);
1348    
1349            foreach my $sim (@sims) {
1350    #           $sim->[0] = $peg1;
1351    #           $sim->[1] = FeatureO->new($figO, $sim->[1]);
1352            }
1353        }
1354    
1355        return @sims;
1356    }
1357    
1358    
1359    
1360    =head3 bbhs
1361    
1362    =over 4
1363    
1364    =item FUNCTION:
1365    
1366    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1367    corresponding to the pre-computed BBHs for that PEG.
1368    
1369    =item USAGE:
1370    
1371    C<< my @bbhs = $pegO->bbhs(); >>
1372    
1373    =item RETURNS:
1374    
1375    List of BBHO objects.
1376    
1377    =back
1378    
1379    =cut
1380    
1381    sub bbhs {
1382        my($self) = @_;
1383    
1384        my $figO = $self->{_figO};
1385        my $fig  = $figO->{_fig};
1386    
1387        my @bbhs  = $fig->bbhs($self->id);
1388        return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
1389                                                      _peg1 => $self->id,
1390                                                      _peg2 => $peg2,
1391                                                      _psc => $sc,
1392                                                      _bit_score => $bs
1393                                                    },'BBHO') } @bbhs;
1394    }
1395    
1396    
1397    =head3 display
1398    
1399    =over 4
1400    
1401    =item FUNCTION:
1402    
1403    Prints info about a "FeatureO" object to STDOUT.
1404    
1405    =item USAGE:
1406    
1407    C<< $pegO->display(); >>
1408    
1409    =item RETURNS;
1410    
1411    (void)
1412    
1413    =back
1414    
1415    =cut
1416    
1417    sub display {
1418        my($self) = @_;
1419    
1420        print join("\t",$self->id,$self->location,$self->function_of),"\n",
1421              $self->dna_seq,"\n",
1422              $self->prot_seq,"\n";
1423    }
1424    
1425    
1426    
1427    ########################################################################
1428    package BBHO;
1429    ########################################################################
1430    
1431    =head1 BBHO
1432    
1433    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1434    
1435    =cut
1436    
1437    
1438    =head3 new
1439    
1440    Constructor of BBHO objects.
1441    
1442    (NOTE: The "average user" should never need to invoke this method.)
1443    
1444    =cut
1445    
1446    sub new {
1447        my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
1448    
1449        my $self = {};
1450        $self->{_figO}      = $figO;
1451        $self->{_peg1}      = $peg1;
1452        $self->{_peg2}      = $peg2;
1453        $self->{_psc}       = $sc;
1454        $self->{_bit_score} = $normalized_bitscore
1455    
1456    }
1457    
1458    
1459    
1460    =head3 peg1
1461    
1462    =over 4
1463    
1464    =item USAGE:
1465    
1466    C<< my $peg1 = $bbh->peg1(); >>
1467    
1468    =item RETURNS:
1469    
1470    A "FeatureO" object corresponding to the "query" sequence
1471    in a BBH pair.
1472    
1473    =back
1474    
1475    =cut
1476    
1477    sub peg1 {
1478        my($self) = @_;
1479    
1480        my $figO = $self->{_figO};
1481        return new FeatureO($figO,$self->{_peg1});
1482    }
1483    
1484    =head3 peg2
1485    
1486    =over 4
1487    
1488    =item USAGE:
1489    
1490    C<< my $peg2 = $bbh->peg2(); >>
1491    
1492    =item RETURNS:
1493    
1494    A "FeatureO" object corresponding to the "database" sequence
1495    in a BBH pair.
1496    
1497    =back
1498    
1499    =cut
1500    
1501    sub peg2 {
1502        my($self) = @_;
1503    
1504        my $figO = $self->{_figO};
1505        return new FeatureO($figO,$self->{_peg2});
1506    }
1507    
1508    
1509    
1510    =head3 psc
1511    
1512    =over 4
1513    
1514    =item USAGE:
1515    
1516    C<< my $psc = $bbh->psc(); >>
1517    
1518    =item RETURNS:
1519    
1520    The numerical value of the BLAST E-value for the pair.
1521    
1522    =back
1523    
1524    =cut
1525    
1526    sub psc {
1527        my($self) = @_;
1528    
1529        return $self->{_psc};
1530    }
1531    
1532    
1533    
1534    =head3 norm_bitscore
1535    
1536    
1537    =over 4
1538    
1539    =item USAGE:
1540    
1541    C<< my $bsc = $bbh->norm_bitscore(); >>
1542    
1543    =item RETURNS:
1544    
1545    The "BLAST bit-score per aligned character" for the pair.
1546    
1547    =back
1548    
1549    =cut
1550    
1551    sub norm_bitscore {
1552        my($self) = @_;
1553    
1554        return $self->{_bit_score};
1555    }
1556    
1557    
1558    
1559    ########################################################################
1560    package AnnotationO;
1561    ########################################################################
1562    
1563    =head1 AnnotationO
1564    
1565    Methods for accessing SEED annotations.
1566    
1567    =cut
1568    
1569    
1570    
1571    =head3 new
1572    
1573    =over 4
1574    
1575    =item FUNCTION:
1576    
1577    Cronstruct a new "AnnotationO" object
1578    
1579    =item USAGE:
1580    
1581    C<< my $annotO = AnnotationO->new( $fid, $timestamp, $who, $text); >>
1582    
1583    =item C<$fid>
1584    
1585    A feature identifier.
1586    
1587    =item C<$timestamp>
1588    
1589    The C<UN*X> timestamp one wishes to associate with the annotation.
1590    
1591    =item C<$who>
1592    
1593    The annotator's user-name.
1594    
1595    =item C<$text>
1596    
1597    The textual content of the annotation.
1598    
1599    =item RETURNS:
1600    
1601    An "AnnotationO" object.
1602    
1603    =back
1604    
1605    =cut
1606    
1607    sub new {
1608        my($class,$fid,$timestamp,$who,$text) = @_;
1609    
1610        my $self = {};
1611        $self->{_fid} = $fid;
1612        $self->{_timestamp} = $timestamp;
1613        $self->{_who} = $who;
1614        $self->{_text} = $text;
1615        return bless $self, $class;
1616    }
1617    
1618    
1619    
1620    =head3 fid
1621    
1622    =over 4
1623    
1624    =item FUNCTION:
1625    
1626    Extract the feature-ID that was annotated.
1627    
1628    =item USAGE:
1629    
1630    C<< my $fid = $annotO->fid(); >>
1631    
1632    =item RETURNS;
1633    
1634    The feature-ID as a string.
1635    
1636    =back
1637    
1638    =cut
1639    
1640    sub fid {
1641        my($self) = @_;
1642    
1643        return $self->{_fid};
1644    }
1645    
1646    
1647    
1648    =head3 timestamp
1649    
1650    =over 4
1651    
1652    =item FUNCTION:
1653    
1654    Extract the C<UN*X> timestamp of the annotation.
1655    
1656    =item USAGE:
1657    
1658    C<< my $fid = $annotO->timestamp(); >>
1659    
1660    =item RETURNS;
1661    
1662    The timestamp as a string.
1663    
1664    =back
1665    
1666    =cut
1667    
1668    sub timestamp {
1669        my($self,$convert) = @_;
1670    
1671        if ($convert)
1672        {
1673            return scalar localtime($self->{_timestamp});
1674        }
1675        else
1676        {
1677            return $self->{_timestamp};
1678        }
1679    }
1680    
1681    
1682    
1683    =head3 made_by
1684    
1685    =over 4
1686    
1687    =item FUNCTION:
1688    
1689    Extract the annotator's user-name.
1690    
1691    =item USAGE:
1692    
1693    C<< my $fid = $annotO->made_by(); >>
1694    
1695    =item RETURNS;
1696    
1697    The username of the annotator, as a string.
1698    
1699    =back
1700    
1701    =cut
1702    
1703    sub made_by {
1704        my($self) = @_;
1705    
1706        my $who = $self->{_who};
1707        $who =~ s/^master://i;
1708        return $who;
1709    }
1710    
1711    
1712    
1713    =head3 text
1714    
1715    =over 4
1716    
1717    =item FUNCTION:
1718    
1719    Extract the text of the annotation.
1720    
1721    =item USGAE:
1722    
1723    C<< my $text = $annotO->text(); >>
1724    
1725    =item RETURNS:
1726    
1727    The text of the annotation, as a string.
1728    
1729    =back
1730    
1731    =cut
1732    
1733    sub text {
1734        my($self) = @_;
1735    
1736        my $text = $self->{_text};
1737        return $text;
1738    }
1739    
1740    
1741    =head3 display
1742    
1743    =over 4
1744    
1745    =item FUNCTION:
1746    
1747    Print the contents of an "AnnotationO" object to B<STDOUT>
1748    in human-readable form.
1749    
1750    =item USAGE:
1751    
1752    C<< my $annotO->display(); >>
1753    
1754    =item RETURNS:
1755    
1756    (void)
1757    
1758    =back
1759    
1760    =cut
1761    
1762    sub display {
1763        my($self) = @_;
1764    
1765        print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1766    }
1767    
1768    
1769    
1770    ########################################################################
1771    package CouplingO;
1772    ########################################################################
1773    use Data::Dumper;
1774    
1775    =head1 CouplingO
1776    
1777    Methods for accessing the "Functional coupling scores"
1778    of PEGs in close physical proximity to each other.
1779    
1780    =cut
1781    
1782    
1783    
1784    =head3 new
1785    
1786    =over 4
1787    
1788    =item FUNCTION:
1789    
1790    Construct a new "CouplingO" object
1791    encapsulating the "functional coupling" score
1792    between a pair of features in some genome.
1793    
1794    =item USAGE:
1795    
1796    C<< $couplingO = CouplingO->new($figO, $fid1, $fid2, $sc); >>
1797    
1798    =item C<$figO>
1799    
1800    Parent "FIGO" object.
1801    
1802    =item C<$fid1> and C<$fid2>
1803    
1804    A pair of feature-IDs.
1805    
1806    =item C<$sc>
1807    
1808    A functional-coupling score
1809    
1810    =item RETURNS:
1811    
1812    A "CouplingO" object.
1813    
1814    =back
1815    
1816    =cut
1817    
1818    sub new {
1819        my($class,$figO,$peg1,$peg2,$sc) = @_;
1820    
1821        ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1822        ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1823        my $self = {};
1824        $self->{_figO} = $figO;
1825        $self->{_peg1} = $peg1;
1826        $self->{_peg2} = $peg2;
1827        $self->{_sc}   = $sc;
1828        return bless $self, $class;
1829    }
1830    
1831    
1832    
1833    =head3 peg1
1834    
1835    =over 4
1836    
1837    =item FUNCTION:
1838    
1839    Returns a "FeatureO" object corresponding to the first FID in a coupled pair.
1840    
1841    =item USAGE:
1842    
1843    C<< my $peg1 = $couplingO->peg1(); >>
1844    
1845    =item RETURNS:
1846    
1847    A "FeatureO" object.
1848    
1849    =back
1850    
1851    =cut
1852    
1853    sub peg1 {
1854        my($self) = @_;
1855    
1856        my $figO = $self->{_figO};
1857        return new FeatureO($figO,$self->{_peg1});
1858    }
1859    
1860    
1861    
1862    =head3 peg2
1863    
1864    =over 4
1865    
1866    =item FUNCTION:
1867    
1868    Returns a "FeatureO" object corresponding to the second FID in a coupled pair.
1869    
1870    =item USAGE:
1871    
1872    C<< my $peg2 = $couplingO->peg2(); >>
1873    
1874    =item RETURNS:
1875    
1876    A "FeatureO" object.
1877    
1878    =back
1879    
1880    =cut
1881    
1882    sub peg2 {
1883        my($self) = @_;
1884    
1885        my $figO = $self->{_figO};
1886        return new FeatureO($figO,$self->{_peg2});
1887    }
1888    
1889    
1890    
1891    =head3 sc
1892    
1893    =over 4
1894    
1895    =item FUNCTION:
1896    
1897    Extracts the "functional coupling" score from a "CouplingO" object.
1898    
1899    =item USAGE:
1900    
1901    C<< my $sc = $couplingO->sc(); >>
1902    
1903    =item RETURNS:
1904    
1905    A scalar score.
1906    
1907    =back
1908    
1909    =cut
1910    
1911    sub sc {
1912        my($self) = @_;
1913    
1914        return $self->{_sc};
1915    }
1916    
1917    
1918    
1919    =head3 evidence
1920    
1921    =over 4
1922    
1923    =item FUNCTION:
1924    
1925    Fetch the evidence for a "functional coupling" between two close PEGs,
1926    in the form of a list of objects describing the "Pairs of Close Homologs" (PCHs)
1927    supporting the existence of a functional coupling between the two close PEGs.
1928    
1929    =item USAGE:
1930    
1931    C<< my $evidence = $couplingO->evidence(); >>
1932    
1933    =item RETURNS
1934    
1935    List of pairs of "FeatureO" objects.
1936    
1937    =back
1938    
1939    =cut
1940    
1941    sub evidence {
1942        my($self) = @_;
1943    
1944        my $figO = $self->{_figO};
1945        my $fig  = $figO->{_fig};
1946        my @ev = ();
1947        foreach my $tuple ($fig->coupling_evidence($self->peg1->id,$self->peg2->id))
1948        {
1949            my($peg3,$peg4,$rep) = @$tuple;
1950            push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
1951                      &FeatureO::new('FeatureO',$figO,$peg4),
1952                      $rep]);
1953        }
1954        return @ev;
1955    }
1956    
1957    
1958    
1959    =head3 display
1960    
1961    =over 4
1962    
1963    =item FUNCTION:
1964    
1965    Print the contents of a "CouplingO" object to B<STDOUT> in human-readable form.
1966    
1967    =item USAGE:
1968    
1969    C<< $couplingO->display(); >>
1970    
1971    =item RETURNS:
1972    
1973    (Void)
1974    
1975    =back
1976    
1977    =cut
1978    
1979    sub display {
1980        my($self) = @_;
1981    
1982        print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1983    }
1984    
1985    
1986    
1987    ########################################################################
1988    package SubsystemO;
1989    ########################################################################
1990    use Data::Dumper;
1991    use Subsystem;
1992    
1993    =head1 SubsystemO
1994    
1995    =cut
1996    
1997    
1998    
1999    =head3 new
2000    
2001    =cut
2002    
2003    sub new {
2004        my($class,$figO,$name) = @_;
2005    
2006        my $self = {};
2007        $self->{_figO} = $figO;
2008        $self->{_id} = $name;
2009    
2010        return bless $self, $class;
2011    }
2012    
2013    
2014    
2015    =head3 id
2016    
2017    =cut
2018    
2019    sub id {
2020        my($self) = @_;
2021    
2022        return $self->{_id};
2023    }
2024    
2025    
2026    
2027    =head3 usable
2028    
2029    
2030    =cut
2031    
2032    sub usable {
2033        my($self) = @_;
2034    
2035        my $figO = $self->{_figO};
2036        my $fig  = $figO->{_fig};
2037        return $fig->usable_subsystem($self->id);
2038    }
2039    
2040    
2041    
2042    =head3 genomes
2043    
2044    =cut
2045    
2046    sub genomes {
2047        my($self) = @_;
2048    
2049        my $figO = $self->{_figO};
2050        my $subO = $self->{_subO};
2051        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
2052    
2053        return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
2054    }
2055    
2056    
2057    
2058    =head3 roles
2059    
2060    =cut
2061    
2062    sub roles {
2063        my($self) = @_;
2064    
2065        my $figO = $self->{_figO};
2066        my $subO = $self->{_subO};
2067        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
2068    
2069        return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);
2070    }
2071    
2072    
2073    
2074    =head3 curator
2075    
2076    =cut
2077    
2078    sub curator {
2079        my($self) = @_;
2080    
2081        my $figO = $self->{_figO};
2082        my $subO = $self->{_subO};
2083        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
2084    
2085        return $subO->get_curator;
2086    }
2087    
2088    
2089    
2090    
2091    =head3 variant
2092    
2093    =cut
2094    
2095    sub variant {
2096        my($self,$genome) = @_;
2097    
2098        my $figO = $self->{_figO};
2099        my $subO = $self->{_subO};
2100        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
2101    
2102        return $subO->get_variant_code_for_genome($genome->id);
2103    }
2104    
2105    
2106    
2107    =head3 pegs_in_cell
2108    
2109    =cut
2110    
2111    sub pegs_in_cell {
2112        my($self,$genome,$role) = @_;
2113    
2114        my $figO = $self->{_figO};
2115        my $subO = $self->{_subO};
2116        if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
2117    
2118        return $subO->get_pegs_from_cell($genome->id,$role->id);
2119    }
2120    
2121    
2122    
2123    ########################################################################
2124    package FunctionalRoleO;
2125    ########################################################################
2126    use Data::Dumper;
2127    
2128    =head1 FunctionalRoleO
2129    
2130    Methods for accessing the functional roles of features.
2131    
2132    =cut
2133    
2134    
2135    =head3 new
2136    
2137    =cut
2138    
2139    sub new {
2140        my($class,$figO,$fr) = @_;
2141    
2142        my $self = {};
2143        $self->{_figO} = $figO;
2144        $self->{_id} = $fr;
2145        return bless $self, $class;
2146    }
2147    
2148    
2149    
2150    =head3 id
2151    
2152    =cut
2153    
2154    sub id {
2155        my($self) = @_;
2156    
2157        return $self->{_id};
2158    }
2159    
2160    
2161    
2162    ########################################################################
2163    package FigFamO;
2164    ########################################################################
2165    use FigFams;
2166    use FigFam;
2167    
2168    
2169    =head1 FigFamO
2170    
2171    =cut
2172    
2173    
2174    =head3 new
2175    
2176    =cut
2177    
2178    sub new {
2179        my($class,$figO,$id) = @_;
2180    
2181        my $self = {};
2182        $self->{_figO} = $figO;
2183        $self->{_id} = $id;
2184        return bless $self, $class;
2185    }
2186    
2187    
2188    
2189    =head3 id
2190    
2191    =cut
2192    
2193    sub id {
2194        my($self) = @_;
2195    
2196        return $self->{_id};
2197    }
2198    
2199    
2200    =head3 function
2201    
2202    =cut
2203    
2204    sub function {
2205        my($self) = @_;
2206    
2207        my $fig  = $self->{_figO}->{_fig};
2208        my $famO = $self->{_famO};
2209        if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2210    
2211        return $famO->family_function;
2212    }
2213    
2214    
2215    
2216    =head3 members
2217    
2218    =cut
2219    
2220    sub members {
2221        my($self) = @_;
2222    
2223        my $figO = $self->{_figO};
2224        my $fig  = $figO->{_fig};
2225      my $famO = $self->{_famO};      my $famO = $self->{_famO};
2226      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2227    
2228      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2229  }  }
2230    
2231    =head3 rep_seqs
2232    
2233    =cut
2234    
2235  sub rep_seqs {  sub rep_seqs {
2236      my($self) = @_;      my($self) = @_;
2237    
# Line 592  Line 2243 
2243      return $famO->representatives;      return $famO->representatives;
2244  }  }
2245    
2246    
2247    
2248    =head3 should_be_member
2249    
2250    =cut
2251    
2252  sub should_be_member {  sub should_be_member {
2253      my($self,$seq) = @_;      my($self,$seq) = @_;
2254    
# Line 605  Line 2262 
2262    
2263    
2264    
2265    =head3 display
2266    
2267    =cut
2268    
2269  sub display {  sub display {
2270      my($self) = @_;      my($self) = @_;
2271    
# Line 613  Line 2274 
2274    
2275    
2276    
2277    ########################################################################
2278  package Attribute;  package Attribute;
2279    ########################################################################
2280    =head1 Attribute
2281    
2282    (Note yet implemented.)
2283    
2284    =cut
2285    
2286  1;  1;
2287    __END__
2288    
2289    =head1 Examples
2290    
2291    =head3 Display all complete, prokaryotic genomes
2292    
2293    use FIGO;
2294    my $figO = new FIGO;
2295    
2296    foreach $genome ($figO->genomes('complete','prokaryotic'))
2297    {
2298        $genome->display;
2299    }
2300    
2301    #---------------------------------------------
2302    
2303    use FIG;
2304    my $fig = new FIG;
2305    
2306    foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
2307    {
2308        print join("\t",("Genome",$genome,$fig->genus_species($genome))),"\n";
2309    }
2310    
2311    ###############################################
2312    
2313    =head3 Show how to access contigs and extract sequence
2314    
2315    use FIGO;
2316    my $figO = new FIGO;
2317    
2318    $genomeId = '83333.1';
2319    my $genome = new GenomeO($figO,$genomeId);
2320    
2321    foreach $contig ($genome->contigs_of)
2322    {
2323        $tag1 = $contig->dna_seq(1,10);
2324        $tag2 = $contig->dna_seq(10,1);
2325        print join("\t",($tag1,$tag2,$contig->id,$contig->contig_length)),"\n";
2326    }
2327    
2328    #---------------------------------------------
2329    
2330    use FIG;
2331    my $fig = new FIG;
2332    
2333    $genomeId = '83333.1';
2334    
2335    $contig_lengths = $fig->contig_lengths($genomeId);
2336    
2337    foreach $contig ($fig->contigs_of($genomeId))
2338    {
2339        $tag1 = $fig->dna_seq($genomeId,join("_",($contig,1,10)));
2340        $tag2 = $fig->dna_seq($genomeId,join("_",($contig,10,1)));
2341        print join("\t",($tag1,$tag2,$contig,$contig_lengths->{$contig})),"\n";
2342    }
2343    
2344    ###############################################
2345    
2346    ### accessing data related to features
2347    
2348    use FIGO;
2349    my $figO = new FIGO;
2350    
2351    my $genome = new GenomeO($figO,"83333.1");
2352    my $peg  = "fig|83333.1.peg.4";
2353    my $pegO = new FeatureO($figO,$peg);
2354    
2355    print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
2356          $pegO->dna_seq,"\n",
2357          $pegO->prot_seq,"\n";
2358    
2359    foreach $fidO ($genome->features_of('rna'))
2360    {
2361        print join("\t",$fidO->id,$fidO->location,$fidO->function_of),"\n";
2362    }
2363    
2364    #---------------------------------------------
2365    
2366    
2367    use FIG;
2368    my $fig = new FIG;
2369    
2370    my $genome = "83333.1";
2371    my $peg  = "fig|83333.1.peg.4";
2372    
2373    print join("\t",$peg,scalar $fig->feature_location($peg),scalar $fig->function_of($peg)),"\n",
2374          $fig->dna_seq($genome,$fig->feature_location($peg)),"\n",
2375          $fig->get_translation($peg),"\n";
2376    
2377    foreach $fid ($fig->all_features($genome,'rna'))
2378    {
2379        print join("\t",$fid,scalar $fig->feature_location($fid),scalar $fig->function_of($fid)),"\n";
2380    }
2381    
2382    ###############################################
2383    
2384    ### accessing similarities
2385    
2386    use FIGO;
2387    my $figO = new FIGO;
2388    
2389    $peg  = "fig|83333.1.peg.4";
2390    $pegO = new FeatureO($figO,$peg);
2391    
2392    @sims = $pegO->sims;  # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
2393                          # sims (including non-FIG sequences
2394    foreach $sim (@sims)
2395    {
2396        $peg2  = $sim->id2;
2397        $pegO2 = new FeatureO($figO,$peg2);
2398        $func  = $pegO2->function_of;
2399        $sc    = $sim->psc;
2400        print join("\t",($peg2,$sc,$func)),"\n";
2401    }
2402    
2403    #---------------------------------------------
2404    
2405    
2406    use FIG;
2407    my $fig = new FIG;
2408    
2409    $peg  = "fig|83333.1.peg.4";
2410    
2411    @sims = $fig->sims($peg,1000,1.0e-5,"fig");
2412    foreach $sim (@sims)
2413    {
2414        $peg2  = $sim->id2;
2415        $func  = $fig->function_of($peg2);
2416        $sc    = $sim->psc;
2417        print join("\t",($peg2,$sc,$func)),"\n";
2418    }
2419    
2420    ###############################################
2421    
2422    ### accessing BBHs
2423    
2424    use FIGO;
2425    my $figO = new FIGO;
2426    
2427    $peg  = "fig|83333.1.peg.4";
2428    $pegO = new FeatureO($figO,$peg);
2429    
2430    @bbhs = $pegO->bbhs;
2431    foreach $bbh (@bbhs)
2432    {
2433        $peg2  = $bbh->peg2;
2434        $pegO2 = new FeatureO($figO,$peg2);
2435        $func  = $pegO2->function_of;
2436        $sc    = $bbh->psc;
2437        print join("\t",($peg2,$sc,$func)),"\n";
2438    }
2439    
2440    #---------------------------------------------
2441    
2442    use FIG;
2443    my $fig = new FIG;
2444    
2445    $peg  = "fig|83333.1.peg.4";
2446    
2447    @bbhs = $fig->bbhs($peg);
2448    foreach $bbh (@bbhs)
2449    {
2450        ($peg2,$sc,$bit_score) = @$bbh;
2451        $func  = $fig->function_of($peg2);
2452        print join("\t",($peg2,$sc,$func)),"\n";
2453    }
2454    
2455    ###############################################
2456    
2457    ### accessing annotations
2458    
2459    use FIGO;
2460    my $figO = new FIGO;
2461    
2462    $peg  = "fig|83333.1.peg.4";
2463    $pegO = new FeatureO($figO,$peg);
2464    
2465    @annotations = $pegO->annotations;
2466    
2467    foreach $ann (@annotations)
2468    {
2469        print join("\n",$ann->fid,$ann->timestamp(1),$ann->made_by,$ann->text),"\n\n";
2470    }
2471    
2472    #---------------------------------------------
2473    
2474    use FIG;
2475    my $fig = new FIG;
2476    
2477    $peg = "fig|83333.1.peg.4";
2478    @annotations = $fig->feature_annotations($peg);
2479    foreach $_ (@annotations)
2480    {
2481        (undef,$ts,$who,$text) = @$_;
2482        $who =~ s/master://i;
2483        print "$ts\n$who\n$text\n\n";
2484    }
2485    
2486    ###############################################
2487    
2488    ### accessing coupling data
2489    
2490    
2491    use FIGO;
2492    my $figO = new FIGO;
2493    
2494    my $peg  = "fig|83333.1.peg.4";
2495    my $pegO = new FeatureO($figO,$peg);
2496    foreach $coupled ($pegO->coupled_to)
2497    {
2498        print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
2499        foreach $tuple ($coupled->evidence)
2500        {
2501            my($peg3O,$peg4O,$rep) = @$tuple;
2502            print "\t",join("\t",($peg3O->id,$peg4O->id,$rep)),"\n";
2503        }
2504        print "\n";
2505    }
2506    
2507    #---------------------------------------------
2508    
2509    
2510    use FIG;
2511    my $fig = new FIG;
2512    
2513    my $peg1  = "fig|83333.1.peg.4";
2514    foreach $coupled ($fig->coupled_to($peg1))
2515    {
2516        ($peg2,$sc) = @$coupled;
2517        print join("\t",($peg1,$peg2,$sc)),"\n";
2518        foreach $tuple ($fig->coupling_evidence($peg1,$peg2))
2519        {
2520            my($peg3,$peg4,$rep) = @$tuple;
2521            print "\t",join("\t",($peg3,$peg4,$rep)),"\n";
2522        }
2523        print "\n";
2524    }
2525    
2526    ###############################################
2527    
2528    =head3 Accessing Subsystem data
2529    
2530    use FIGO;
2531    my $figO = new FIGO;
2532    
2533    foreach $sub ($figO->subsystems)
2534    {
2535        if ($sub->usable)
2536        {
2537            print join("\t",($sub->id,$sub->curator)),"\n";
2538    
2539            print "\tRoles\n";
2540            @roles = $sub->roles;
2541            foreach $role (@roles)
2542            {
2543                print "\t\t",join("\t",($role->id)),"\n";
2544            }
2545    
2546            print "\tGenomes\n";
2547            foreach $genome ($sub->genomes)
2548            {
2549                print "\t\t",join("\t",($sub->variant($genome),
2550                                        $genome->id,
2551                                        $genome->genus_species)),"\n";
2552                @pegs = ();
2553                foreach $role (@roles)
2554                {
2555                    push(@pegs,$sub->pegs_in_cell($genome,$role));
2556                }
2557                print "\t\t\t",join(",",@pegs),"\n";
2558            }
2559        }
2560    }
2561    
2562    #---------------------------------------------
2563    
2564    use FIG;
2565    my $fig = new FIG;
2566    
2567    foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
2568    {
2569        $subO = new Subsystem($sub,$fig);
2570        $curator = $subO->get_curator;
2571        print join("\t",($sub,$curator)),"\n";
2572    
2573        print "\tRoles\n";
2574        @roles = $subO->get_roles;
2575        foreach $role (@roles)
2576        {
2577            print "\t\t",join("\t",($role)),"\n";
2578        }
2579    
2580        print "\tGenomes\n";
2581        foreach $genome ($subO->get_genomes)
2582        {
2583            print "\t\t",join("\t",($subO->get_variant_code_for_genome($genome),
2584                                    $genome,
2585                                    $fig->genus_species($genome))),"\n";
2586            foreach $role (@roles)
2587            {
2588                push(@pegs,$subO->get_pegs_from_cell($genome,$role));
2589            }
2590            print "\t\t\t",join(",",@pegs),"\n";
2591        }
2592        print "\n";
2593    }
2594    
2595    ###############################################
2596    
2597    =head3 Accessing FIGfams
2598    
2599    use FIGO;
2600    my $figO = new FIGO;
2601    
2602    foreach $fam ($figO->all_figfams)
2603    {
2604        print join("\t",($fam->id,$fam->function)),"\n";
2605        foreach $pegO ($fam->members)
2606        {
2607            $peg = $pegO->id;
2608            print "\t$peg\n";
2609        }
2610    }
2611    
2612    #---------------------------------------------
2613    
2614    use FIG;
2615    use FigFam;
2616    use FigFams;
2617    
2618    my $fig = new FIG;
2619    my $figfams = new FigFams($fig);
2620    
2621    foreach $fam ($figfams->all_families)
2622    {
2623        my $figfam = new FigFam($fig,$fam);
2624        print join("\t",($fam,$figfam->family_function)),"\n";
2625        foreach $peg ($figfam->list_members)
2626        {
2627            print "\t$peg\n";
2628        }
2629    }
2630    
2631    ###############################################
2632    
2633    =head3 Placing a sequence into a FIGfam
2634    
2635    use FIGO;
2636    my $figO = new FIGO;
2637    
2638    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2639    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2640    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2641    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2642    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2643    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2644    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2645    RKLMMNHQ";
2646    $seq =~ s/\n//gs;
2647    
2648    my($fam,$sims) = $figO->family_containing($seq);
2649    
2650    if ($fam)
2651    {
2652        print join("\t",($fam->id,$fam->function)),"\n";
2653        print &Dumper($sims);
2654    }
2655    else
2656    {
2657        print "Could not place it in a family\n";
2658    }
2659    
2660    #---------------------------------------------
2661    
2662    use FIG;
2663    use FigFam;
2664    use FigFams;
2665    
2666    my $fig = new FIG;
2667    my $figfams = new FigFams($fig);
2668    
2669    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2670    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2671    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2672    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2673    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2674    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2675    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2676    RKLMMNHQ";
2677    $seq =~ s/\n//gs;
2678    
2679    my($fam,$sims) = $figfams->place_in_family($seq);
2680    
2681    if ($fam)
2682    {
2683        print join("\t",($fam->family_id,$fam->family_function)),"\n";
2684        print &Dumper($sims);
2685    }
2686    else
2687    {
2688        print "Could not place it in a family\n";
2689    }
2690    
2691    ###############################################
2692    
2693    =head3 Getting representative sequences for a FIGfam
2694    
2695    use FIGO;
2696    my $figO = new FIGO;
2697    
2698    $fam         = "FIG102446";
2699    my $famO     = &FigFamO::new('FigFamO',$figO,$fam);
2700    my @rep_seqs = $famO->rep_seqs;
2701    
2702    foreach $seq (@rep_seqs)
2703    {
2704        print ">query\n$seq\n";
2705    }
2706    
2707    #---------------------------------------------
2708    
2709    use FIG;
2710    use FigFam;
2711    use FigFams;
2712    
2713    my $fig = new FIG;
2714    
2715    $fam         = "FIG102446";
2716    my $famO     = new FigFam($fig,$fam);
2717    my @rep_seqs = $famO->representatives;
2718    
2719    foreach $seq (@rep_seqs)
2720    {
2721        print ">query\n$seq\n";
2722    }
2723    
2724    
2725    ###############################################
2726    
2727    
2728    =head3 Testing for membership in FIGfam
2729    
2730    use FIGO;
2731    my $figO = new FIGO;
2732    
2733    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2734    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2735    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2736    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2737    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2738    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2739    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2740    RKLMMNHQ";
2741    $seq =~ s/\n//gs;
2742    
2743    $fam                  = "FIG102446";
2744    my $famO              = &FigFamO::new('FigFamO',$figO,$fam);
2745    my($should_be, $sims) = $famO->should_be_member($seq);
2746    
2747    if ($should_be)
2748    {
2749        print join("\t",($famO->id,$famO->function)),"\n";
2750        print &Dumper($sims);
2751    }
2752    else
2753    {
2754        print "Sequence should not be added to family\n";
2755    }
2756    
2757    #---------------------------------------------
2758    
2759    use FIG;
2760    use FigFam;
2761    use FigFams;
2762    
2763    my $fig = new FIG;
2764    
2765    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
2766    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
2767    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
2768    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
2769    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
2770    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
2771    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
2772    RKLMMNHQ";
2773    $seq =~ s/\n//gs;
2774    
2775    $fam                  = "FIG102446";
2776    my $famO              = new FigFam($fig,$fam);
2777    my($should_be, $sims) = $famO->should_be_member($seq);
2778    
2779    if ($should_be)
2780    {
2781        print join("\t",($famO->family_id,$famO->family_function)),"\n";
2782        print &Dumper($sims);
2783    }
2784    else
2785    {
2786        print "Sequence should not be added to family\n";
2787    }
2788    
2789    =cut
2790    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.31

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3