[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.8, Thu Feb 22 14:28:32 2007 UTC
# Line 25  Line 25 
25  use Tracer;  use Tracer;
26  use Data::Dumper;  use Data::Dumper;
27  use FigFams;  use FigFams;
28    use gjoparseblast;
29    
30    =head1 FIGO Methods
31    
32    =head3 new
33    
34    Constructs a new FIGO object.
35    
36    =over4
37    
38    =item USAGE:
39    
40    C<< my $figo = FIGO->new();           #...Subclass defaults to FIG >>
41    
42    C<< my $figo = FIGO->new('SPROUT');   #...Subclass is a SPROUT object >>
43    
44    =back
45    
46    =cut
47    
48  sub new {  sub new {
49      my($class,$low_level) = @_;      my($class,$low_level) = @_;
# Line 41  Line 60 
60    
61      my $self = {};      my $self = {};
62      $self->{_fig} = $fig;      $self->{_fig} = $fig;
63        $self->{_tmp_dir} = $FIG_Config::temp;
64      return bless $self, $class;      return bless $self, $class;
65  }  }
66    
67    
68    
69    =head3 genomes
70    
71    Returns a list of Taxonomy-IDs, possibly constrained by selection criteria.
72    (Default: Empty constraint returns all Tax-IDs in the SEED or SPROUT.)
73    
74    =over4
75    
76    =item USAGE:
77    
78    C<< my @tax_ids = $figo->genomes(); >>
79    
80    C<< my @tax_ids = $figo->genomes( @constraints ); >>
81    
82    =item @constraints
83    One or more element of: complete, prokaryotic, eukaryotic, bacterial, archaeal, nmpdr.
84    
85    =item RETURNS: List of Tax-IDs.
86    
87    =item EXAMPLE: L<Display all complete, prokaryotic genomes>
88    
89    =back
90    
91    =cut
92    
93  sub genomes {  sub genomes {
94      my($self,@constraints) = @_;      my($self,@constraints) = @_;
95      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 88  Line 134 
134      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;      return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
135  }  }
136    
137    
138    
139    =head3 subsystems
140    
141    =over4
142    
143    =item RETURNS:
144    List of all subsystems.
145    
146    =item EXAMPLE: L<Accessing Subsystem data>
147    
148    =back
149    
150    =cut
151    
152  sub subsystems {  sub subsystems {
153      my($self) = @_;      my($self) = @_;
154      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 95  Line 156 
156      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;      return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
157  }  }
158    
159    
160    =head3 functional_roles
161    
162    (Not yet implemented)
163    
164    =over
165    
166    =item RETURNS:
167    
168    =item EXAMPLE:
169    
170    =back
171    
172    =cut
173    
174  sub functional_roles {  sub functional_roles {
175      my($self) = @_;      my($self) = @_;
176      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 104  Line 180 
180      return @functional_roles;      return @functional_roles;
181  }  }
182    
183    
184    
185    =head3 all_figfams
186    
187    Returns a list of all FIGfam objects.
188    
189    =over4
190    
191    =item USAGE:  C<< foreach $fam ($figO->all_figfams) { #...Do something } >>
192    
193    =item RETURNS: List of FIGfam Objects
194    
195    =item EXAMPLE: L<Accessing FIGfams>
196    
197    =back
198    
199    =cut
200    
201  sub all_figfams {  sub all_figfams {
202      my($self) = @_;      my($self) = @_;
203      my $fig = $self->{_fig};      my $fig = $self->{_fig};
# Line 111  Line 205 
205      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;      return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
206  }  }
207    
208    
209    
210    =head3 family_containing
211    
212    =over4
213    
214    =item USAGE:   C<< my ($fam, $sims) = $figO->family_containing($seq); >>
215    
216    =item $seq:    A protein translation string.
217    
218    =item RETURNS:
219          $fam:  A FIGfam Object.
220          $sims: A set of similarity objects.
221    
222    =item EXAMPLE: L<Placing a sequence into a FIGfam>
223    
224    =back
225    
226    =cut
227    
228  sub family_containing {  sub family_containing {
229      my($self,$seq) = @_;      my($self,$seq) = @_;
230    
# Line 127  Line 241 
241      }      }
242  }  }
243    
 package GenomeO;  
244    
245    ########################################################################
246    package GenomeO;
247    ########################################################################
248  use Data::Dumper;  use Data::Dumper;
249    
250    =head1 GenomeO
251    
252    =cut
253    
254    =head3 new
255    
256    Constructor of GenomeO objects.
257    
258    =over4
259    
260    =item USAGE:
261    C<< my $org = GenomeO->new($figo, $tax_id); >>
262    
263    =item RETURNS: A new GenomeO object.
264    
265    =back
266    
267    =cut
268    
269  sub new {  sub new {
270      my($class,$figO,$genomeId) = @_;      my($class,$figO,$genomeId) = @_;
271    
# Line 140  Line 275 
275      return bless $self, $class;      return bless $self, $class;
276  }  }
277    
278    
279    
280    =head3 id
281    
282    =over4
283    
284    =item USAGE:   C<< my $tax_id = $org->id(); >>
285    
286    =item RETURNS: Taxonomy-ID of GenomeO object.
287    
288    =back
289    
290    =cut
291    
292  sub id {  sub id {
293      my($self) = @_;      my($self) = @_;
294    
295      return $self->{_id};      return $self->{_id};
296  }  }
297    
298    
299    
300    =head3 genus_species
301    
302    =over4
303    
304    =item USAGE:   C<< $gs = $genome->genus_species(); >>
305    
306    =item RETURNS: Genus-species-strain string
307    
308    =back
309    
310    =cut
311    
312  sub genus_species {  sub genus_species {
313      my($self) = @_;      my($self) = @_;
314    
# Line 153  Line 316 
316      return $fig->genus_species($self->{_id});      return $fig->genus_species($self->{_id});
317  }  }
318    
319    
320    =head3 contigs_of
321    
322    =over4
323    
324    =item RETURNS: List of C<contig> objects contained in a C<GenomeO> object.
325    
326    =item EXAMPLE: L<Show how to access contigs and extract sequence>
327    
328    =back
329    
330    =cut
331    
332  sub contigs_of {  sub contigs_of {
333      my($self) = @_;      my($self) = @_;
334    
# Line 161  Line 337 
337      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);
338  }  }
339    
340    
341    
342    =head3 features_of
343    
344    =cut
345    
346  sub features_of {  sub features_of {
347      my($self,$type) = @_;      my($self,$type) = @_;
348    
# Line 170  Line 352 
352      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);      return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
353  }  }
354    
355    
356    =head3 display
357    
358    Prints the genus, species, and strain information about a genome to STDOUT.
359    
360    =over4
361    
362    =item USAGE:   C<< $genome->display(); >>
363    
364    =item RETURNS: Null
365    
366    =back
367    
368    =cut
369    
370  sub display {  sub display {
371      my($self) = @_;      my($self) = @_;
372    
373      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";      print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
374  }  }
375    
 package ContigO;  
376    
377    
378    ########################################################################
379    package ContigO;
380    ########################################################################
381  use Data::Dumper;  use Data::Dumper;
382    
383    =head1 ContigO
384    
385    Methods for working with DNA sequence objects.
386    
387    =cut
388    
389    =head3 new
390    
391    Contig constructor.
392    
393    =over4
394    
395    =item USAGE:
396    C<< $contig = ContigO->new( $figO, $genomeId, $contigId); >>
397    
398    =item $figO: A FIGO object.
399    
400    =item $genomeId: Taxon-ID for the genome the contig is from.
401    
402    =item $contigId: Identifier for the contig
403    
404    =item RETURNS: A "ContigO" object.
405    
406    =back
407    
408    =cut
409    
410  sub new {  sub new {
411      my($class,$figO,$genomeId,$contigId) = @_;      my($class,$figO,$genomeId,$contigId) = @_;
412    
# Line 190  Line 417 
417      return bless $self, $class;      return bless $self, $class;
418  }  }
419    
420    
421    
422    =head3 id
423    
424    =over4
425    
426    =item RETURNS: Sequence ID string of "ContigO" object
427    
428    =back
429    
430    =cut
431    
432  sub id {  sub id {
433      my($self) = @_;      my($self) = @_;
434    
435      return $self->{_id};      return $self->{_id};
436  }  }
437    
438    
439    =head3 genome
440    
441    =over4
442    
443    =item USAGE:
444        C<< my $tax_id = $contig->genome(); >>
445    
446    =item RETURNS: GenomeO object containing the contig object.
447    
448    =back
449    
450    =cut
451    
452  sub genome {  sub genome {
453      my($self) = @_;      my($self) = @_;
454    
455      return $self->{_genome};      return $self->{_genome};
456  }  }
457    
458    
459    
460    =head3 contig_length
461    
462    =over4
463    
464    =item USAGE:
465        C<< my $len = $contig->contig_length(); >>
466    
467    =item RETURNS: Length of contig's DNA sequence.
468    
469    =back
470    
471    =cut
472    
473  sub contig_length {  sub contig_length {
474      my($self) = @_;      my($self) = @_;
475    
# Line 210  Line 478 
478      return $contig_lengths->{$self->id};      return $contig_lengths->{$self->id};
479  }  }
480    
481    
482    =head3 dna_seq
483    
484    =over4
485    
486    =item USAGE:
487        C<< my $seq = $contig->dna_seq(beg, $end); >>
488    
489    =item $beg: Begining point of DNA subsequence
490    
491    =item $end: End point of DNA subsequence
492    
493    =item RETURNS: string of DNA sequence from $beg to $end
494    
495    (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
496    
497    =back
498    
499    =cut
500    
501  sub dna_seq {  sub dna_seq {
502      my($self,$beg,$end) = @_;      my($self,$beg,$end) = @_;
503    
# Line 226  Line 514 
514      }      }
515  }  }
516    
517    
518    =head3 display
519    
520    Prints summary information about a "ContigO" object to STDOUT:
521    
522    Genus, species, strain
523    
524    Contig ID
525    
526    Contig length
527    
528    =over4
529    
530    =item RETURNS: Nil
531    
532    =back
533    
534    =cut
535    
536  sub display {  sub display {
537      my($self) = @_;      my($self) = @_;
538    
539      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";      print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";
540  }  }
541    
 package FeatureO;  
542    
543    
544    ########################################################################
545    package FeatureO;
546    ########################################################################
547  use Data::Dumper;  use Data::Dumper;
548    
549    =head1 FeatureO
550    
551    =cut
552    
553    
554    
555    =head1 new
556    
557    Constructor of "FeatureO" objects
558    
559    =cut
560    
561  sub new {  sub new {
562      my($class,$figO,$fid) = @_;      my($class,$figO,$fid) = @_;
563    
# Line 246  Line 568 
568      return bless $self, $class;      return bless $self, $class;
569  }  }
570    
571    
572    =head3 id
573    
574    =cut
575    
576  sub id {  sub id {
577      my($self) = @_;      my($self) = @_;
578    
579      return $self->{_id};      return $self->{_id};
580  }  }
581    
582    
583    
584    =head3 genome
585    
586    =cut
587    
588  sub genome {  sub genome {
589      my($self) = @_;      my($self) = @_;
590    
# Line 259  Line 592 
592      return $1;      return $1;
593  }  }
594    
595    
596    
597    =head3 type
598    
599    =cut
600    
601  sub type {  sub type {
602      my($self) = @_;      my($self) = @_;
603    
# Line 266  Line 605 
605      return $1;      return $1;
606  }  }
607    
608    
609    
610    
611    =head3 location
612    
613    =cut
614    
615  sub location {  sub location {
616      my($self) = @_;      my($self) = @_;
617    
# Line 273  Line 619 
619      return scalar $fig->feature_location($self->id);      return scalar $fig->feature_location($self->id);
620  }  }
621    
622    
623    
624    =head3 dna_seq
625    
626    =cut
627    
628  sub dna_seq {  sub dna_seq {
629      my($self) = @_;      my($self) = @_;
630    
# Line 282  Line 634 
634      return $fig->dna_seq(&FIG::genome_of($fid),@loc);      return $fig->dna_seq(&FIG::genome_of($fid),@loc);
635  }  }
636    
637    
638    
639    =head3 prot_seq
640    
641    =cut
642    
643  sub prot_seq {  sub prot_seq {
644      my($self) = @_;      my($self) = @_;
645    
# Line 291  Line 649 
649      return $fig->get_translation($fid);      return $fig->get_translation($fid);
650  }  }
651    
652    
653    
654    =head3 function_of
655    
656    =cut
657    
658  sub function_of {  sub function_of {
659      my($self) = @_;      my($self) = @_;
660    
# Line 299  Line 663 
663      return scalar $fig->function_of($fid);      return scalar $fig->function_of($fid);
664  }  }
665    
666    
667    
668    =head3 coupled_to
669    
670    =cut
671    
672  sub coupled_to {  sub coupled_to {
673      my($self) = @_;      my($self) = @_;
674    
# Line 315  Line 685 
685      return @coupled;      return @coupled;
686  }  }
687    
688    
689    
690    =head3 annotations
691    
692    =cut
693    
694  sub annotations {  sub annotations {
695      my($self) = @_;      my($self) = @_;
696    
# Line 324  Line 700 
700      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);      return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
701  }  }
702    
703  sub display {  sub in_subsystems {
704      my($self) = @_;      my($self) = @_;
705        my $figO = $self->{_figO};
706        my $fig  = $figO->{_fig};
707    
708      print join("\t",$self->id,$self->location,$self->function_of),"\n",      return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);
           $self->dna_seq,"\n",  
           $self->prot_seq,"\n";  
709  }  }
710    
 package AnnotationO;  
711    
712  sub new {  =head3 possibly_truncated
     my($class,$fid,$timestamp,$who,$text) = @_;  
713    
714      my $self = {};  =cut
     $self->{_fid} = $fid;  
     $self->{_timestamp} = $timestamp;  
     $self->{_who} = $who;  
     $self->{_text} = $text;  
     return bless $self, $class;  
 }  
715    
716  sub fid {  sub possibly_truncated {
717      my($self) = @_;      my($self) = @_;
718        my $figO = $self->{_figO};
719        my $fig  = $figO->{_fig};
720    
721      return $self->{_fid};      return $fig->possibly_truncated($self->id);
722  }  }
723    
 sub timestamp {  
     my($self,$convert) = @_;  
724    
725      if ($convert)  
726    =head3 possible_frameshift
727    
728    =cut
729    
730    sub possible_frameshift {
731        my($self) = @_;
732        my $figO = $self->{_figO};
733        my($tmp_dir) = $figO->{_tmp_dir};
734    
735        if (! $self->possibly_truncated)
736      {      {
737          return scalar localtime($self->{_timestamp});          my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);
738      }          if (my $sim = shift @sims)
     else  
739      {      {
740          return $self->{_timestamp};              my $peg2 = $sim->id2;
741                my $ln1  = $sim->ln1;
742                my $ln2  = $sim->ln2;
743                my $b2   = $sim->b2;
744                my $e2   = $sim->e2;
745                my $adjL = 100 + (($b2-1) * 3);
746                my $adjR = 100 + (($ln2 - $e2) * 3);
747                if ($ln2 > (1.2 * $ln1))
748                {
749                    my $loc = $self->location;
750                    if ($loc =~ /^(\S+)_(\d+)_(\d+)/)
751                    {
752                        my $contig = $1;
753                        my $beg    = $2;
754                        my $end = $3;
755                        my $contigO = new ContigO($figO,$self->genome,$contig);
756                        my $begA = &max(1,$beg - $adjL);
757                        my $endA = &min($end+$adjR,$contigO->contig_length);
758                        my $dna  = $contigO->dna_seq($begA,$endA);
759                        open(TMP,">$tmp_dir/tmp_dna") || die "couild not open tmp_dna";
760                        print TMP ">dna\n$dna\n";
761                        close(TMP);
762    
763                        my $peg2O = new FeatureO($figO,$peg2);
764                        my $prot  = $peg2O->prot_seq;
765                        open(TMP,">$tmp_dir/tmp_prot") || die "could not open tmp_prot";
766                        print TMP ">tmp_prot\n$prot\n";
767                        close(TMP);
768                        &run("formatdb -i $tmp_dir/tmp_dna -pF");
769                        open(BLAST,"blastall -i $tmp_dir/tmp_prot -d $tmp_dir/tmp_dna -p tblastn -FF -e 1.0e-50 |")
770                            || die "could not blast";
771    
772                        my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);
773                        my @hsps       = sort { $a->[0] <=> $b->[0] }
774                                         map { [$_->[9],$_->[10],$_->[12],$_->[13]] }
775                                         grep { $_->[1] < 1.0e-50 }
776                                         @{$db_seq_out->[6]};
777                        my @prot = map { [$_->[0],$_->[1]] } @hsps;
778                        my @dna  = map { [$_->[2],$_->[3]] } @hsps;
779                        if (&covers(\@prot,length($prot),3) && &covers(\@dna,3*length($prot),9))
780                        {
781                            return 1;
782                        }
783                    }
784                }
785            }
786      }      }
787        return 0;
788  }  }
789    
 sub made_by {  
     my($self) = @_;  
790    
     my $who = $self->{_who};  
     $who =~ s/^master://i;  
     return $who;  
 }  
791    
792  sub text {  =head3 run
793      my($self) = @_;  
794    =cut
795    
796    sub run {
797        my($cmd) = @_;
798        (system($cmd) == 0) || Confess("FAILED: $cmd");
799    }
800    
801    
802    
803    =head3 max
804    
805    =cut
806    
807    sub max {
808        my($x,$y) = @_;
809        return ($x < $y) ? $y : $x;
810    }
811    
812    
813    
814    =head3 min
815    
816    =cut
817    
818    sub min {
819        my($x,$y) = @_;
820        return ($x < $y) ? $x : $y;
821    }
822    
823    
824    
825    =head3 covers
826    
827    =cut
828    
829    sub covers {
830        my($hsps,$ln,$diff) = @_;
831    
832        my $hsp1 = shift @$hsps;
833        my $hsp2;
834        while ($hsp1 && ($hsp2 = shift @$hsps) && ($hsp1 = &merge($hsp1,$hsp2,$diff))) {}
835        return ($hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
836    }
837    
838    
839    
840    =head3 merge
841    
842    =cut
843    
844    sub merge {
845        my($hsp1,$hsp2,$diff) = @_;
846    
847        my($b1,$e1) = @$hsp1;
848        my($b2,$e2) = @$hsp2;
849        return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;
850    }
851    
852    
853    
854    =head3 sims
855    
856    =cut
857    
858    use Sim;
859    sub sims {
860        my($self,%args) = @_;
861    
862        my $figO = $self->{_figO};
863        my $fig  = $figO->{_fig};
864    
865        my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
866        my $all    = $args{-all}    ? $args{-all}    : "fig";
867        my $max    = $args{-max}    ? $args{-max}    : 10000;
868    
869        return $fig->sims($self->id,$max,$cutoff,$all);
870    }
871    
872    
873    
874    =head3 bbhs
875    
876    =cut
877    
878    sub bbhs {
879        my($self) = @_;
880    
881        my $figO = $self->{_figO};
882        my $fig  = $figO->{_fig};
883    
884        my @bbhs  = $fig->bbhs($self->id);
885        return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
886                                                      _peg1 => $self->id,
887                                                      _peg2 => $peg2,
888                                                      _psc => $sc,
889                                                      _bit_score => $bs
890                                                    },'BBHO') } @bbhs;
891    }
892    
893    =head3 display
894    
895    =cut
896    
897    sub display {
898        my($self) = @_;
899    
900        print join("\t",$self->id,$self->location,$self->function_of),"\n",
901              $self->dna_seq,"\n",
902              $self->prot_seq,"\n";
903    }
904    
905    
906    
907    ########################################################################
908    package BBHO;
909    ########################################################################
910    
911    =head1 BBHO
912    
913    =cut
914    
915    
916    =head3 new
917    
918    =cut
919    
920    sub new {
921        my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
922    
923        my $self = {};
924        $self->{_figO}      = $figO;
925        $self->{_peg1}      = $peg1;
926        $self->{_peg2}      = $peg2;
927        $self->{_psc}       = $sc;
928        $self->{_bit_score} = $normalized_bitscore
929    
930    }
931    
932    
933    =head3 peg1
934    
935    =cut
936    
937    sub peg1 {
938        my($self) = @_;
939    
940        my $figO = $self->{_figO};
941        return new FeatureO($figO,$self->{_peg1});
942    }
943    
944    =head3 peg2
945    
946    =cut
947    
948    sub peg2 {
949        my($self) = @_;
950    
951        my $figO = $self->{_figO};
952        return new FeatureO($figO,$self->{_peg2});
953    }
954    
955    
956    
957    =head3 psc
958    
959    =cut
960    
961    sub psc {
962        my($self) = @_;
963    
964        return $self->{_psc};
965    }
966    
967    
968    
969    =head3 norm_bitscore
970    
971    =cut
972    
973    sub norm_bitscore {
974        my($self) = @_;
975    
976        return $self->{_bit_score};
977    }
978    
979    
980    
981    ########################################################################
982    package AnnotationO;
983    ########################################################################
984    
985    =head1 AnnotationO
986    
987    =cut
988    
989    
990    
991    =head3 new
992    
993    =cut
994    
995    sub new {
996        my($class,$fid,$timestamp,$who,$text) = @_;
997    
998        my $self = {};
999        $self->{_fid} = $fid;
1000        $self->{_timestamp} = $timestamp;
1001        $self->{_who} = $who;
1002        $self->{_text} = $text;
1003        return bless $self, $class;
1004    }
1005    
1006    
1007    
1008    =head3 fid
1009    
1010    =cut
1011    
1012    sub fid {
1013        my($self) = @_;
1014    
1015        return $self->{_fid};
1016    }
1017    
1018    
1019    
1020    =head3 timestamp
1021    
1022    =cut
1023    
1024    sub timestamp {
1025        my($self,$convert) = @_;
1026    
1027        if ($convert)
1028        {
1029            return scalar localtime($self->{_timestamp});
1030        }
1031        else
1032        {
1033            return $self->{_timestamp};
1034        }
1035    }
1036    
1037    
1038    
1039    =head3 made_by
1040    
1041    =cut
1042    
1043    sub made_by {
1044        my($self) = @_;
1045    
1046        my $who = $self->{_who};
1047        $who =~ s/^master://i;
1048        return $who;
1049    }
1050    
1051    
1052    
1053    =head3 text
1054    
1055    =cut
1056    
1057    sub text {
1058        my($self) = @_;
1059    
1060      my $text = $self->{_text};      my $text = $self->{_text};
1061      return $text;      return $text;
1062  }  }
1063    
1064    
1065    =head3 display
1066    
1067    =cut
1068    
1069  sub display {  sub display {
1070      my($self) = @_;      my($self) = @_;
1071    
1072      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";      print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1073  }  }
1074    
 package CouplingO;  
1075    
1076    
1077    ########################################################################
1078    package CouplingO;
1079    ########################################################################
1080  use Data::Dumper;  use Data::Dumper;
1081    
1082    =head3 new
1083    
1084    =cut
1085    
1086  sub new {  sub new {
1087      my($class,$figO,$peg1,$peg2,$sc) = @_;      my($class,$figO,$peg1,$peg2,$sc) = @_;
1088    
# Line 402  Line 1096 
1096      return bless $self, $class;      return bless $self, $class;
1097  }  }
1098    
1099    
1100    
1101    =head3 peg1
1102    
1103    =cut
1104    
1105  sub peg1 {  sub peg1 {
1106      my($self) = @_;      my($self) = @_;
1107    
1108      return $self->{_peg1};      my $figO = $self->{_figO};
1109        return new FeatureO($figO,$self->{_peg1});
1110  }  }
1111    
1112    
1113    
1114    =head3 peg1
1115    
1116    =cut
1117    
1118  sub peg2 {  sub peg2 {
1119      my($self) = @_;      my($self) = @_;
1120    
1121      return $self->{_peg2};      my $figO = $self->{_figO};
1122        return new FeatureO($figO,$self->{_peg2});
1123  }  }
1124    
1125    
1126    
1127    =head3 sc
1128    
1129    =cut
1130    
1131  sub sc {  sub sc {
1132      my($self) = @_;      my($self) = @_;
1133    
1134      return $self->{_sc};      return $self->{_sc};
1135  }  }
1136    
1137    
1138    
1139    =head3 evidence
1140    
1141    =cut
1142    
1143  sub evidence {  sub evidence {
1144      my($self) = @_;      my($self) = @_;
1145    
# Line 436  Line 1156 
1156      return @ev;      return @ev;
1157  }  }
1158    
1159    
1160    
1161    =head3 display
1162    
1163    =cut
1164    
1165  sub display {  sub display {
1166      my($self) = @_;      my($self) = @_;
1167    
1168      print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";      print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1169  }  }
1170    
 package SubsystemO;  
1171    
1172    
1173    ########################################################################
1174    package SubsystemO;
1175    ########################################################################
1176  use Data::Dumper;  use Data::Dumper;
1177  use Subsystem;  use Subsystem;
1178    
1179    =head1 SubsystemO
1180    
1181    =cut
1182    
1183    
1184    
1185    =head3 new
1186    
1187    =cut
1188    
1189  sub new {  sub new {
1190      my($class,$figO,$name) = @_;      my($class,$figO,$name) = @_;
1191    
# Line 457  Line 1196 
1196      return bless $self, $class;      return bless $self, $class;
1197  }  }
1198    
1199    
1200    
1201    =head3 id
1202    
1203    =cut
1204    
1205  sub id {  sub id {
1206      my($self) = @_;      my($self) = @_;
1207    
1208      return $self->{_id};      return $self->{_id};
1209  }  }
1210    
1211    
1212    
1213    =head3 usable
1214    
1215    =cut
1216    
1217  sub usable {  sub usable {
1218      my($self) = @_;      my($self) = @_;
1219    
# Line 471  Line 1222 
1222      return $fig->usable_subsystem($self->id);      return $fig->usable_subsystem($self->id);
1223  }  }
1224    
1225    
1226    
1227    =head3 genomes
1228    
1229    =cut
1230    
1231  sub genomes {  sub genomes {
1232      my($self) = @_;      my($self) = @_;
1233    
1234      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1235      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1236      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1237        if (! defined($subO)) { return undef }
1238    
1239      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;      return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1240  }  }
1241    
1242    =head3 roles
1243    
1244    =cut
1245    
1246  sub roles {  sub roles {
1247      my($self) = @_;      my($self) = @_;
1248    
1249      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1250      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1251      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1252        if (! defined($subO)) { return undef }
1253      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);      return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) }  $subO->get_roles($self->id);
1254  }  }
1255    
1256    =head3 curator
1257    
1258    =cut
1259    
1260  sub curator {  sub curator {
1261      my($self) = @_;      my($self) = @_;
1262    
1263      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1264      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1265      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1266        return defined($subO) ? $subO->get_curator : undef;
     return $subO->get_curator;  
1267  }  }
1268    
1269    
1270    
1271    
1272    =head3 variant
1273    
1274    =cut
1275    
1276  sub variant {  sub variant {
1277      my($self,$genome) = @_;      my($self,$genome) = @_;
1278    
1279      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1280      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1281      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1282        if (! defined($subO)) { return undef }
1283    
1284      return $subO->get_variant_code_for_genome($genome->id);      return $subO->get_variant_code_for_genome($genome->id);
1285  }  }
1286    
1287    
1288    
1289    =head3 pegs_in_cell
1290    
1291    =cut
1292    
1293  sub pegs_in_cell {  sub pegs_in_cell {
1294      my($self,$genome,$role) = @_;      my($self,$genome,$role) = @_;
1295    
1296      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1297      my $subO = $self->{_subO};      my $subO = $self->{_subO};
1298      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }      if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1299        if (! defined($subO)) { return undef }
1300    
1301      return $subO->get_pegs_from_cell($genome->id,$role->id);      return $subO->get_pegs_from_cell($genome->id,$role->id);
1302  }  }
1303    
 package FunctionalRoleO;  
1304    
1305    
1306    ########################################################################
1307    package FunctionalRoleO;
1308    ########################################################################
1309  use Data::Dumper;  use Data::Dumper;
1310    
1311    =head1 FunctionalRoleO
1312    
1313    =cut
1314    
1315    
1316    =head3 new
1317    
1318    =cut
1319    
1320  sub new {  sub new {
1321      my($class,$figO,$fr) = @_;      my($class,$figO,$fr) = @_;
1322    
# Line 534  Line 1326 
1326      return bless $self, $class;      return bless $self, $class;
1327  }  }
1328    
1329    
1330    
1331    =head3 id
1332    
1333    =cut
1334    
1335  sub id {  sub id {
1336      my($self) = @_;      my($self) = @_;
1337    
1338      return $self->{_id};      return $self->{_id};
1339  }  }
1340    
 package FigFamO;  
1341    
1342    
1343    ########################################################################
1344    package FigFamO;
1345    ########################################################################
1346  use FigFams;  use FigFams;
1347  use FigFam;  use FigFam;
1348    
1349    
1350    =head1 FigFamO
1351    
1352    =cut
1353    
1354    
1355    =head3 new
1356    
1357    =cut
1358    
1359  sub new {  sub new {
1360      my($class,$figO,$id) = @_;      my($class,$figO,$id) = @_;
1361    
# Line 554  Line 1365 
1365      return bless $self, $class;      return bless $self, $class;
1366  }  }
1367    
1368    
1369    
1370    =head3 id
1371    
1372    =cut
1373    
1374  sub id {  sub id {
1375      my($self) = @_;      my($self) = @_;
1376    
1377      return $self->{_id};      return $self->{_id};
1378  }  }
1379    
1380    
1381    =head3 function
1382    
1383    =cut
1384    
1385  sub function {  sub function {
1386      my($self) = @_;      my($self) = @_;
1387    
# Line 570  Line 1392 
1392      return $famO->family_function;      return $famO->family_function;
1393  }  }
1394    
1395    
1396    
1397    =head3 members
1398    
1399    =cut
1400    
1401  sub members {  sub members {
1402      my($self) = @_;      my($self) = @_;
1403    
# Line 581  Line 1409 
1409      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;
1410  }  }
1411    
1412    
1413    
1414    =head3 rep_seqs
1415    
1416    =cut
1417    
1418  sub rep_seqs {  sub rep_seqs {
1419      my($self) = @_;      my($self) = @_;
1420    
# Line 592  Line 1426 
1426      return $famO->representatives;      return $famO->representatives;
1427  }  }
1428    
1429    
1430    
1431    =head3 should_be_member
1432    
1433    =cut
1434    
1435  sub should_be_member {  sub should_be_member {
1436      my($self,$seq) = @_;      my($self,$seq) = @_;
1437    
# Line 605  Line 1445 
1445    
1446    
1447    
1448    =head3 display
1449    
1450    =cut
1451    
1452  sub display {  sub display {
1453      my($self) = @_;      my($self) = @_;
1454    
# Line 613  Line 1457 
1457    
1458    
1459    
1460    ########################################################################
1461  package Attribute;  package Attribute;
1462    ########################################################################
1463    =head1 Attribute
1464    
1465    =cut
1466    
1467  1;  1;
1468    __END__
1469    
1470    =head1 Examples
1471    
1472    =head3 Display all complete, prokaryotic genomes
1473    
1474    use FIGO;
1475    my $figO = new FIGO;
1476    
1477    foreach $genome ($figO->genomes('complete','prokaryotic'))
1478    {
1479        $genome->display;
1480    }
1481    
1482    #---------------------------------------------
1483    
1484    use FIG;
1485    my $fig = new FIG;
1486    
1487    foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
1488    {
1489        print join("\t",("Genome",$genome,$fig->genus_species($genome))),"\n";
1490    }
1491    
1492    ###############################################
1493    
1494    =head3 Show how to access contigs and extract sequence
1495    
1496    use FIGO;
1497    my $figO = new FIGO;
1498    
1499    $genomeId = '83333.1';
1500    my $genome = new GenomeO($figO,$genomeId);
1501    
1502    foreach $contig ($genome->contigs_of)
1503    {
1504        $tag1 = $contig->dna_seq(1,10);
1505        $tag2 = $contig->dna_seq(10,1);
1506        print join("\t",($tag1,$tag2,$contig->id,$contig->contig_length)),"\n";
1507    }
1508    
1509    #---------------------------------------------
1510    
1511    use FIG;
1512    my $fig = new FIG;
1513    
1514    $genomeId = '83333.1';
1515    
1516    $contig_lengths = $fig->contig_lengths($genomeId);
1517    
1518    foreach $contig ($fig->contigs_of($genomeId))
1519    {
1520        $tag1 = $fig->dna_seq($genomeId,join("_",($contig,1,10)));
1521        $tag2 = $fig->dna_seq($genomeId,join("_",($contig,10,1)));
1522        print join("\t",($tag1,$tag2,$contig,$contig_lengths->{$contig})),"\n";
1523    }
1524    
1525    ###############################################
1526    
1527    ### accessing data related to features
1528    
1529    use FIGO;
1530    my $figO = new FIGO;
1531    
1532    my $genome = new GenomeO($figO,"83333.1");
1533    my $peg  = "fig|83333.1.peg.4";
1534    my $pegO = new FeatureO($figO,$peg);
1535    
1536    print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
1537          $pegO->dna_seq,"\n",
1538          $pegO->prot_seq,"\n";
1539    
1540    foreach $fidO ($genome->features_of('rna'))
1541    {
1542        print join("\t",$fidO->id,$fidO->location,$fidO->function_of),"\n";
1543    }
1544    
1545    #---------------------------------------------
1546    
1547    
1548    use FIG;
1549    my $fig = new FIG;
1550    
1551    my $genome = "83333.1";
1552    my $peg  = "fig|83333.1.peg.4";
1553    
1554    print join("\t",$peg,scalar $fig->feature_location($peg),scalar $fig->function_of($peg)),"\n",
1555          $fig->dna_seq($genome,$fig->feature_location($peg)),"\n",
1556          $fig->get_translation($peg),"\n";
1557    
1558    foreach $fid ($fig->all_features($genome,'rna'))
1559    {
1560        print join("\t",$fid,scalar $fig->feature_location($fid),scalar $fig->function_of($fid)),"\n";
1561    }
1562    
1563    ###############################################
1564    
1565    ### accessing similarities
1566    
1567    use FIGO;
1568    my $figO = new FIGO;
1569    
1570    $peg  = "fig|83333.1.peg.4";
1571    $pegO = new FeatureO($figO,$peg);
1572    
1573    @sims = $pegO->sims;  # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
1574                          # sims (including non-FIG sequences
1575    foreach $sim (@sims)
1576    {
1577        $peg2  = $sim->id2;
1578        $pegO2 = new FeatureO($figO,$peg2);
1579        $func  = $pegO2->function_of;
1580        $sc    = $sim->psc;
1581        print join("\t",($peg2,$sc,$func)),"\n";
1582    }
1583    
1584    #---------------------------------------------
1585    
1586    
1587    use FIG;
1588    my $fig = new FIG;
1589    
1590    $peg  = "fig|83333.1.peg.4";
1591    
1592    @sims = $fig->sims($peg,1000,1.0e-5,"fig");
1593    foreach $sim (@sims)
1594    {
1595        $peg2  = $sim->id2;
1596        $func  = $fig->function_of($peg2);
1597        $sc    = $sim->psc;
1598        print join("\t",($peg2,$sc,$func)),"\n";
1599    }
1600    
1601    ###############################################
1602    
1603    ### accessing BBHs
1604    
1605    use FIGO;
1606    my $figO = new FIGO;
1607    
1608    $peg  = "fig|83333.1.peg.4";
1609    $pegO = new FeatureO($figO,$peg);
1610    
1611    @bbhs = $pegO->bbhs;
1612    foreach $bbh (@bbhs)
1613    {
1614        $peg2  = $bbh->peg2;
1615        $pegO2 = new FeatureO($figO,$peg2);
1616        $func  = $pegO2->function_of;
1617        $sc    = $bbh->psc;
1618        print join("\t",($peg2,$sc,$func)),"\n";
1619    }
1620    
1621    #---------------------------------------------
1622    
1623    use FIG;
1624    my $fig = new FIG;
1625    
1626    $peg  = "fig|83333.1.peg.4";
1627    
1628    @bbhs = $fig->bbhs($peg);
1629    foreach $bbh (@bbhs)
1630    {
1631        ($peg2,$sc,$bit_score) = @$bbh;
1632        $func  = $fig->function_of($peg2);
1633        print join("\t",($peg2,$sc,$func)),"\n";
1634    }
1635    
1636    ###############################################
1637    
1638    ### accessing annotations
1639    
1640    use FIGO;
1641    my $figO = new FIGO;
1642    
1643    $peg  = "fig|83333.1.peg.4";
1644    $pegO = new FeatureO($figO,$peg);
1645    
1646    @annotations = $pegO->annotations;
1647    
1648    foreach $ann (@annotations)
1649    {
1650        print join("\n",$ann->fid,$ann->timestamp(1),$ann->made_by,$ann->text),"\n\n";
1651    }
1652    
1653    #---------------------------------------------
1654    
1655    use FIG;
1656    my $fig = new FIG;
1657    
1658    $peg = "fig|83333.1.peg.4";
1659    @annotations = $fig->feature_annotations($peg);
1660    foreach $_ (@annotations)
1661    {
1662        (undef,$ts,$who,$text) = @$_;
1663        $who =~ s/master://i;
1664        print "$ts\n$who\n$text\n\n";
1665    }
1666    
1667    ###############################################
1668    
1669    ### accessing coupling data
1670    
1671    
1672    use FIGO;
1673    my $figO = new FIGO;
1674    
1675    my $peg  = "fig|83333.1.peg.4";
1676    my $pegO = new FeatureO($figO,$peg);
1677    foreach $coupled ($pegO->coupled_to)
1678    {
1679        print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
1680        foreach $tuple ($coupled->evidence)
1681        {
1682            my($peg3O,$peg4O,$rep) = @$tuple;
1683            print "\t",join("\t",($peg3O->id,$peg4O->id,$rep)),"\n";
1684        }
1685        print "\n";
1686    }
1687    
1688    #---------------------------------------------
1689    
1690    
1691    use FIG;
1692    my $fig = new FIG;
1693    
1694    my $peg1  = "fig|83333.1.peg.4";
1695    foreach $coupled ($fig->coupled_to($peg1))
1696    {
1697        ($peg2,$sc) = @$coupled;
1698        print join("\t",($peg1,$peg2,$sc)),"\n";
1699        foreach $tuple ($fig->coupling_evidence($peg1,$peg2))
1700        {
1701            my($peg3,$peg4,$rep) = @$tuple;
1702            print "\t",join("\t",($peg3,$peg4,$rep)),"\n";
1703        }
1704        print "\n";
1705    }
1706    
1707    ###############################################
1708    
1709    =head3 Accessing Subsystem data
1710    
1711    use FIGO;
1712    my $figO = new FIGO;
1713    
1714    foreach $sub ($figO->subsystems)
1715    {
1716        if ($sub->usable)
1717        {
1718            print join("\t",($sub->id,$sub->curator)),"\n";
1719    
1720            print "\tRoles\n";
1721            @roles = $sub->roles;
1722            foreach $role (@roles)
1723            {
1724                print "\t\t",join("\t",($role->id)),"\n";
1725            }
1726    
1727            print "\tGenomes\n";
1728            foreach $genome ($sub->genomes)
1729            {
1730                print "\t\t",join("\t",($sub->variant($genome),
1731                                        $genome->id,
1732                                        $genome->genus_species)),"\n";
1733                @pegs = ();
1734                foreach $role (@roles)
1735                {
1736                    push(@pegs,$sub->pegs_in_cell($genome,$role));
1737                }
1738                print "\t\t\t",join(",",@pegs),"\n";
1739            }
1740        }
1741    }
1742    
1743    #---------------------------------------------
1744    
1745    use FIG;
1746    my $fig = new FIG;
1747    
1748    foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
1749    {
1750        $subO = new Subsystem($sub,$fig);
1751        $curator = $subO->get_curator;
1752        print join("\t",($sub,$curator)),"\n";
1753    
1754        print "\tRoles\n";
1755        @roles = $subO->get_roles;
1756        foreach $role (@roles)
1757        {
1758            print "\t\t",join("\t",($role)),"\n";
1759        }
1760    
1761        print "\tGenomes\n";
1762        foreach $genome ($subO->get_genomes)
1763        {
1764            print "\t\t",join("\t",($subO->get_variant_code_for_genome($genome),
1765                                    $genome,
1766                                    $fig->genus_species($genome))),"\n";
1767            foreach $role (@roles)
1768            {
1769                push(@pegs,$subO->get_pegs_from_cell($genome,$role));
1770            }
1771            print "\t\t\t",join(",",@pegs),"\n";
1772        }
1773        print "\n";
1774    }
1775    
1776    ###############################################
1777    
1778    =head3 Accessing FIGfams
1779    
1780    use FIGO;
1781    my $figO = new FIGO;
1782    
1783    foreach $fam ($figO->all_figfams)
1784    {
1785        print join("\t",($fam->id,$fam->function)),"\n";
1786        foreach $pegO ($fam->members)
1787        {
1788            $peg = $pegO->id;
1789            print "\t$peg\n";
1790        }
1791    }
1792    
1793    #---------------------------------------------
1794    
1795    use FIG;
1796    use FigFam;
1797    use FigFams;
1798    
1799    my $fig = new FIG;
1800    my $figfams = new FigFams($fig);
1801    
1802    foreach $fam ($figfams->all_families)
1803    {
1804        my $figfam = new FigFam($fig,$fam);
1805        print join("\t",($fam,$figfam->family_function)),"\n";
1806        foreach $peg ($figfam->list_members)
1807        {
1808            print "\t$peg\n";
1809        }
1810    }
1811    
1812    ###############################################
1813    
1814    =head3 Placing a sequence into a FIGfam
1815    
1816    use FIGO;
1817    my $figO = new FIGO;
1818    
1819    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1820    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1821    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1822    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1823    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1824    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1825    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1826    RKLMMNHQ";
1827    $seq =~ s/\n//gs;
1828    
1829    my($fam,$sims) = $figO->family_containing($seq);
1830    
1831    if ($fam)
1832    {
1833        print join("\t",($fam->id,$fam->function)),"\n";
1834        print &Dumper($sims);
1835    }
1836    else
1837    {
1838        print "Could not place it in a family\n";
1839    }
1840    
1841    #---------------------------------------------
1842    
1843    use FIG;
1844    use FigFam;
1845    use FigFams;
1846    
1847    my $fig = new FIG;
1848    my $figfams = new FigFams($fig);
1849    
1850    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1851    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1852    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1853    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1854    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1855    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1856    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1857    RKLMMNHQ";
1858    $seq =~ s/\n//gs;
1859    
1860    my($fam,$sims) = $figfams->place_in_family($seq);
1861    
1862    if ($fam)
1863    {
1864        print join("\t",($fam->family_id,$fam->family_function)),"\n";
1865        print &Dumper($sims);
1866    }
1867    else
1868    {
1869        print "Could not place it in a family\n";
1870    }
1871    
1872    ###############################################
1873    
1874    =head3 Getting representative sequences for a FIGfam
1875    
1876    use FIGO;
1877    my $figO = new FIGO;
1878    
1879    $fam         = "FIG102446";
1880    my $famO     = &FigFamO::new('FigFamO',$figO,$fam);
1881    my @rep_seqs = $famO->rep_seqs;
1882    
1883    foreach $seq (@rep_seqs)
1884    {
1885        print ">query\n$seq\n";
1886    }
1887    
1888    #---------------------------------------------
1889    
1890    use FIG;
1891    use FigFam;
1892    use FigFams;
1893    
1894    my $fig = new FIG;
1895    
1896    $fam         = "FIG102446";
1897    my $famO     = new FigFam($fig,$fam);
1898    my @rep_seqs = $famO->representatives;
1899    
1900    foreach $seq (@rep_seqs)
1901    {
1902        print ">query\n$seq\n";
1903    }
1904    
1905    
1906    ###############################################
1907    
1908    
1909    =head3 Testing for membership in FIGfam
1910    
1911    use FIGO;
1912    my $figO = new FIGO;
1913    
1914    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1915    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1916    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1917    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1918    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1919    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1920    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1921    RKLMMNHQ";
1922    $seq =~ s/\n//gs;
1923    
1924    $fam                  = "FIG102446";
1925    my $famO              = &FigFamO::new('FigFamO',$figO,$fam);
1926    my($should_be, $sims) = $famO->should_be_member($seq);
1927    
1928    if ($should_be)
1929    {
1930        print join("\t",($famO->id,$famO->function)),"\n";
1931        print &Dumper($sims);
1932    }
1933    else
1934    {
1935        print "Sequence should not be added to family\n";
1936    }
1937    
1938    #---------------------------------------------
1939    
1940    use FIG;
1941    use FigFam;
1942    use FigFams;
1943    
1944    my $fig = new FIG;
1945    
1946    $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1947    AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1948    IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1949    AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1950    LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1951    MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1952    LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1953    RKLMMNHQ";
1954    $seq =~ s/\n//gs;
1955    
1956    $fam                  = "FIG102446";
1957    my $famO              = new FigFam($fig,$fam);
1958    my($should_be, $sims) = $famO->should_be_member($seq);
1959    
1960    if ($should_be)
1961    {
1962        print join("\t",($famO->family_id,$famO->family_function)),"\n";
1963        print &Dumper($sims);
1964    }
1965    else
1966    {
1967        print "Sequence should not be added to family\n";
1968    }
1969    
1970    =cut
1971    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3