[Bio] / FigKernelPackages / FIGO.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download) (as text)

1 : overbeek 1.1 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 :     package FIGO;
19 :    
20 :     use strict;
21 :     use FIG;
22 :     use FIG_Config;
23 :     use SFXlate;
24 :     use SproutFIG;
25 :     use Tracer;
26 :     use Data::Dumper;
27 :     use FigFams;
28 : overbeek 1.3 use gjoparseblast;
29 : overbeek 1.1
30 : overbeek 1.4 =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 : overbeek 1.1 sub new {
49 :     my($class,$low_level) = @_;
50 :    
51 :     my $fig;
52 :     if ($low_level && ($low_level =~ /sprout/i))
53 :     {
54 :     $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
55 :     }
56 :     else
57 :     {
58 :     $fig = new FIG;
59 :     }
60 :    
61 :     my $self = {};
62 :     $self->{_fig} = $fig;
63 : overbeek 1.3 $self->{_tmp_dir} = $FIG_Config::temp;
64 : overbeek 1.1 return bless $self, $class;
65 :     }
66 :    
67 : overbeek 1.4
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 : overbeek 1.1 sub genomes {
94 :     my($self,@constraints) = @_;
95 :     my $fig = $self->{_fig};
96 :    
97 :     my %constraints = map { $_ => 1 } @constraints;
98 :     my @genomes = ();
99 :    
100 :     if ($constraints{complete})
101 :     {
102 :     @genomes = $fig->genomes('complete');
103 :     }
104 :     else
105 :     {
106 :     @genomes = $fig->genomes;
107 :     }
108 :    
109 :     if ($constraints{prokaryotic})
110 :     {
111 :     @genomes = grep { $fig->is_prokaryotic($_) } @genomes;
112 :     }
113 :    
114 :     if ($constraints{eukaryotic})
115 :     {
116 :     @genomes = grep { $fig->is_eukaryotic($_) } @genomes;
117 :     }
118 :    
119 :     if ($constraints{bacterial})
120 :     {
121 :     @genomes = grep { $fig->is_bacterial($_) } @genomes;
122 :     }
123 :    
124 :     if ($constraints{archaeal})
125 :     {
126 :     @genomes = grep { $fig->is_archaeal($_) } @genomes;
127 :     }
128 :    
129 :     if ($constraints{nmpdr})
130 :     {
131 :     @genomes = grep { $fig->is_NMPDR_genome($_) } @genomes;
132 :     }
133 :    
134 :     return map { &GenomeO::new('GenomeO',$self,$_) } @genomes;
135 :     }
136 :    
137 : overbeek 1.4
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 : overbeek 1.1 sub subsystems {
153 :     my($self) = @_;
154 :     my $fig = $self->{_fig};
155 :    
156 :     return map { &SubsystemO::new('SubsystemO',$self,$_) } $fig->all_subsystems;
157 :     }
158 :    
159 : overbeek 1.4
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 : overbeek 1.1 sub functional_roles {
175 :     my($self) = @_;
176 :     my $fig = $self->{_fig};
177 :    
178 :     my @functional_roles = ();
179 :    
180 :     return @functional_roles;
181 :     }
182 :    
183 : overbeek 1.4
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 : overbeek 1.1 sub all_figfams {
202 :     my($self) = @_;
203 :     my $fig = $self->{_fig};
204 :     my $fams = new FigFams($fig);
205 :     return map { &FigFamO::new('FigFamO',$self,$_) } $fams->all_families;
206 :     }
207 :    
208 : overbeek 1.4
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 : overbeek 1.1 sub family_containing {
229 :     my($self,$seq) = @_;
230 :    
231 :     my $fig = $self->{_fig};
232 :     my $fams = new FigFams($fig);
233 :     my($fam,$sims) = $fams->place_in_family($seq);
234 :     if ($fam)
235 :     {
236 :     return (&FigFamO::new('FigFamO',$self,$fam->family_id),$sims);
237 :     }
238 :     else
239 :     {
240 :     return undef;
241 :     }
242 :     }
243 :    
244 : overbeek 1.4
245 :     ########################################################################
246 : overbeek 1.1 package GenomeO;
247 : overbeek 1.4 ########################################################################
248 :     use Data::Dumper;
249 :    
250 :     =head1 GenomeO
251 :    
252 :     =cut
253 :    
254 :     =head3 new
255 :    
256 :     Constructor of GenomeO objects.
257 : overbeek 1.1
258 : overbeek 1.4 =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 : overbeek 1.1
269 :     sub new {
270 :     my($class,$figO,$genomeId) = @_;
271 :    
272 :     my $self = {};
273 :     $self->{_figO} = $figO;
274 :     $self->{_id} = $genomeId;
275 :     return bless $self, $class;
276 :     }
277 :    
278 : overbeek 1.4
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 : overbeek 1.1 sub id {
293 :     my($self) = @_;
294 :    
295 :     return $self->{_id};
296 :     }
297 :    
298 : overbeek 1.4
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 : overbeek 1.1 sub genus_species {
313 :     my($self) = @_;
314 :    
315 :     my $fig = $self->{_figO}->{_fig};
316 :     return $fig->genus_species($self->{_id});
317 :     }
318 :    
319 : overbeek 1.4
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 : overbeek 1.1 sub contigs_of {
333 :     my($self) = @_;
334 :    
335 :     my $figO = $self->{_figO};
336 :     my $fig = $figO->{_fig};
337 :     return map { &ContigO::new('ContigO',$figO,$self->id,$_) } $fig->contigs_of($self->id);
338 :     }
339 :    
340 : overbeek 1.4
341 :    
342 :     =head3 features_of
343 :    
344 :     =cut
345 :    
346 : overbeek 1.1 sub features_of {
347 :     my($self,$type) = @_;
348 :    
349 :     my $figO = $self->{_figO};
350 :     my $fig = $figO->{_fig};
351 :    
352 :     return map { &FeatureO::new('FeatureO',$figO,$_) } $fig->all_features($self->id,$type);
353 :     }
354 :    
355 : overbeek 1.4
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 : overbeek 1.1 sub display {
371 :     my($self) = @_;
372 :    
373 :     print join("\t",("Genome",$self->id,$self->genus_species)),"\n";
374 :     }
375 :    
376 : overbeek 1.4
377 :    
378 :     ########################################################################
379 : overbeek 1.1 package ContigO;
380 : overbeek 1.4 ########################################################################
381 :     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 : overbeek 1.1
393 : overbeek 1.4 =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 : overbeek 1.1
410 :     sub new {
411 :     my($class,$figO,$genomeId,$contigId) = @_;
412 :    
413 :     my $self = {};
414 :     $self->{_figO} = $figO;
415 :     $self->{_id} = $contigId;
416 :     $self->{_genome} = $genomeId;
417 :     return bless $self, $class;
418 :     }
419 :    
420 : overbeek 1.4
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 : overbeek 1.1 sub id {
433 :     my($self) = @_;
434 :    
435 :     return $self->{_id};
436 :     }
437 :    
438 : overbeek 1.4
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 : overbeek 1.1 sub genome {
453 :     my($self) = @_;
454 :    
455 :     return $self->{_genome};
456 :     }
457 :    
458 : overbeek 1.4
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 : overbeek 1.1 sub contig_length {
474 :     my($self) = @_;
475 :    
476 :     my $fig = $self->{_figO}->{_fig};
477 :     my $contig_lengths = $fig->contig_lengths($self->genome);
478 :     return $contig_lengths->{$self->id};
479 :     }
480 :    
481 : overbeek 1.4
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 : overbeek 1.1 sub dna_seq {
502 :     my($self,$beg,$end) = @_;
503 :    
504 :     my $fig = $self->{_figO}->{_fig};
505 :     my $max = $self->contig_length;
506 :     if (($beg && (&FIG::between(1,$beg,$max))) &&
507 :     ($end && (&FIG::between(1,$end,$max))))
508 :     {
509 :     return $fig->dna_seq($self->genome,join("_",($self->id,$beg,$end)));
510 :     }
511 :     else
512 :     {
513 :     return undef;
514 :     }
515 :     }
516 :    
517 : overbeek 1.4
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 : overbeek 1.1 sub display {
537 :     my($self) = @_;
538 :    
539 :     print join("ContigO",$self->genome,$self->id,$self->contig_length),"\n";
540 :     }
541 :    
542 : overbeek 1.4
543 :    
544 :     ########################################################################
545 : overbeek 1.1 package FeatureO;
546 : overbeek 1.4 ########################################################################
547 :     use Data::Dumper;
548 :    
549 :     =head1 FeatureO
550 :    
551 :     =cut
552 :    
553 : overbeek 1.1
554 : overbeek 1.4
555 :     =head1 new
556 :    
557 :     Constructor of "FeatureO" objects
558 :    
559 :     =cut
560 : overbeek 1.1
561 :     sub new {
562 :     my($class,$figO,$fid) = @_;
563 :    
564 :     ($fid =~ /^fig\|\d+\.\d+\.[^\.]+\.\d+$/) || return undef;
565 :     my $self = {};
566 :     $self->{_figO} = $figO;
567 :     $self->{_id} = $fid;
568 :     return bless $self, $class;
569 :     }
570 :    
571 : overbeek 1.4
572 :     =head3 id
573 :    
574 :     =cut
575 :    
576 : overbeek 1.1 sub id {
577 :     my($self) = @_;
578 :    
579 :     return $self->{_id};
580 :     }
581 :    
582 : overbeek 1.4
583 :    
584 :     =head3 genome
585 :    
586 :     =cut
587 :    
588 : overbeek 1.1 sub genome {
589 :     my($self) = @_;
590 :    
591 :     $self->id =~ /^fig\|(\d+\.\d+)/;
592 :     return $1;
593 :     }
594 :    
595 : overbeek 1.4
596 :    
597 :     =head3 type
598 :    
599 :     =cut
600 :    
601 : overbeek 1.1 sub type {
602 :     my($self) = @_;
603 :    
604 :     $self->id =~ /^fig\|\d+\.\d+\.([^\.]+)/;
605 :     return $1;
606 :     }
607 :    
608 : overbeek 1.4
609 :    
610 :    
611 :     =head3 location
612 :    
613 :     =cut
614 :    
615 : overbeek 1.1 sub location {
616 :     my($self) = @_;
617 :    
618 :     my $fig = $self->{_figO}->{_fig};
619 :     return scalar $fig->feature_location($self->id);
620 :     }
621 :    
622 : overbeek 1.4
623 :    
624 :     =head3 dna_seq
625 :    
626 :     =cut
627 :    
628 : overbeek 1.1 sub dna_seq {
629 :     my($self) = @_;
630 :    
631 :     my $fig = $self->{_figO}->{_fig};
632 :     my $fid = $self->id;
633 :     my @loc = $fig->feature_location($fid);
634 :     return $fig->dna_seq(&FIG::genome_of($fid),@loc);
635 :     }
636 :    
637 : overbeek 1.4
638 :    
639 :     =head3 prot_seq
640 :    
641 :     =cut
642 :    
643 : overbeek 1.1 sub prot_seq {
644 :     my($self) = @_;
645 :    
646 :     ($self->type eq "peg") || return undef;
647 :     my $fig = $self->{_figO}->{_fig};
648 :     my $fid = $self->id;
649 :     return $fig->get_translation($fid);
650 :     }
651 :    
652 : overbeek 1.4
653 :    
654 :     =head3 function_of
655 :    
656 :     =cut
657 :    
658 : overbeek 1.1 sub function_of {
659 :     my($self) = @_;
660 :    
661 :     my $fig = $self->{_figO}->{_fig};
662 :     my $fid = $self->id;
663 :     return scalar $fig->function_of($fid);
664 :     }
665 :    
666 : overbeek 1.4
667 :    
668 :     =head3 coupled_to
669 :    
670 :     =cut
671 :    
672 : overbeek 1.1 sub coupled_to {
673 :     my($self) = @_;
674 :    
675 :     ($self->type eq "peg") || return undef;
676 :     my $figO = $self->{_figO};
677 :     my $fig = $figO->{_fig};
678 :     my $peg1 = $self->id;
679 :     my @coupled = ();
680 :     foreach my $tuple ($fig->coupled_to($peg1))
681 :     {
682 :     my($peg2,$sc) = @$tuple;
683 :     push(@coupled, &CouplingO::new('CouplingO',$figO,$peg1,$peg2,$sc));
684 :     }
685 :     return @coupled;
686 :     }
687 :    
688 : overbeek 1.4
689 :    
690 :     =head3 annotations
691 :    
692 :     =cut
693 :    
694 : overbeek 1.1 sub annotations {
695 :     my($self) = @_;
696 :    
697 :     my $figO = $self->{_figO};
698 :     my $fig = $figO->{_fig};
699 :    
700 :     return map { &AnnotationO::new('AnnotationO',@$_) } $fig->feature_annotations($self->id,1);
701 :     }
702 :    
703 : overbeek 1.5 sub in_subsystems {
704 :     my($self) = @_;
705 :     my $figO = $self->{_figO};
706 :     my $fig = $figO->{_fig};
707 :    
708 :     return map { new SubsystemO($figO,$_) } $fig->peg_to_subsystems($self->id);
709 :     }
710 : overbeek 1.4
711 :    
712 :     =head3 possibly_truncated
713 :    
714 :     =cut
715 :    
716 : overbeek 1.3 sub possibly_truncated {
717 :     my($self) = @_;
718 :     my $figO = $self->{_figO};
719 :     my $fig = $figO->{_fig};
720 :    
721 :     return $fig->possibly_truncated($self->id);
722 :     }
723 :    
724 : overbeek 1.4
725 :    
726 :     =head3 possible_frameshift
727 :    
728 :     =cut
729 :    
730 : overbeek 1.3 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 :     my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);
738 :     if (my $sim = shift @sims)
739 :     {
740 :     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 :    
790 : overbeek 1.4
791 :    
792 :     =head3 run
793 :    
794 :     =cut
795 :    
796 : overbeek 1.3 sub run {
797 :     my($cmd) = @_;
798 :     (system($cmd) == 0) || Confess("FAILED: $cmd");
799 :     }
800 :    
801 : overbeek 1.4
802 :    
803 :     =head3 max
804 :    
805 :     =cut
806 :    
807 : overbeek 1.3 sub max {
808 :     my($x,$y) = @_;
809 :     return ($x < $y) ? $y : $x;
810 :     }
811 :    
812 : overbeek 1.4
813 :    
814 :     =head3 min
815 :    
816 :     =cut
817 :    
818 : overbeek 1.3 sub min {
819 :     my($x,$y) = @_;
820 :     return ($x < $y) ? $x : $y;
821 :     }
822 :    
823 : overbeek 1.4
824 :    
825 :     =head3 covers
826 :    
827 :     =cut
828 :    
829 : overbeek 1.3 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 : overbeek 1.4
839 :    
840 :     =head3 merge
841 :    
842 :     =cut
843 :    
844 : overbeek 1.3 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 : overbeek 1.4
853 :    
854 :     =head3 sims
855 :    
856 :     =cut
857 :    
858 : overbeek 1.2 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 : overbeek 1.4
873 :    
874 :     =head3 bbhs
875 :    
876 :     =cut
877 :    
878 : overbeek 1.2 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 : overbeek 1.6 return map { my($peg2,$sc,$bs) = @$_; bless({ _figO => $figO,
886 :     _peg1 => $self->id,
887 : overbeek 1.2 _peg2 => $peg2,
888 :     _psc => $sc,
889 :     _bit_score => $bs
890 :     },'BBHO') } @bbhs;
891 :     }
892 :    
893 : overbeek 1.4 =head3 display
894 :    
895 :     =cut
896 :    
897 : overbeek 1.1 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 : overbeek 1.4
906 :    
907 :     ########################################################################
908 : overbeek 1.2 package BBHO;
909 : overbeek 1.4 ########################################################################
910 :    
911 :     =head1 BBHO
912 :    
913 :     =cut
914 :    
915 :    
916 :     =head3 new
917 :    
918 :     =cut
919 : overbeek 1.2
920 :     sub new {
921 : overbeek 1.6 my($class,$figO,$peg1,$peg2,$sc,$normalized_bitscore) = @_;
922 : overbeek 1.2
923 :     my $self = {};
924 : overbeek 1.6 $self->{_figO} = $figO;
925 : overbeek 1.2 $self->{_peg1} = $peg1;
926 :     $self->{_peg2} = $peg2;
927 :     $self->{_psc} = $sc;
928 :     $self->{_bit_score} = $normalized_bitscore
929 :    
930 :     }
931 :    
932 : overbeek 1.4
933 :     =head3 peg1
934 :    
935 :     =cut
936 :    
937 : overbeek 1.2 sub peg1 {
938 :     my($self) = @_;
939 :    
940 : overbeek 1.6 my $figO = $self->{_figO};
941 :     return new FeatureO($figO,$self->{_peg1});
942 : overbeek 1.2 }
943 :    
944 : overbeek 1.6 =head3 peg2
945 : overbeek 1.4
946 :     =cut
947 :    
948 : overbeek 1.2 sub peg2 {
949 :     my($self) = @_;
950 :    
951 : overbeek 1.6 my $figO = $self->{_figO};
952 :     return new FeatureO($figO,$self->{_peg2});
953 : overbeek 1.2 }
954 :    
955 : overbeek 1.4
956 :    
957 :     =head3 psc
958 :    
959 :     =cut
960 :    
961 : overbeek 1.2 sub psc {
962 :     my($self) = @_;
963 :    
964 :     return $self->{_psc};
965 :     }
966 :    
967 : overbeek 1.4
968 :    
969 :     =head3 norm_bitscore
970 :    
971 :     =cut
972 :    
973 : overbeek 1.2 sub norm_bitscore {
974 :     my($self) = @_;
975 :    
976 :     return $self->{_bit_score};
977 :     }
978 :    
979 : overbeek 1.4
980 :    
981 :     ########################################################################
982 : overbeek 1.1 package AnnotationO;
983 : overbeek 1.4 ########################################################################
984 :    
985 :     =head1 AnnotationO
986 :    
987 :     =cut
988 :    
989 :    
990 :    
991 :     =head3 new
992 :    
993 :     =cut
994 : overbeek 1.1
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 : overbeek 1.4
1007 :    
1008 :     =head3 fid
1009 :    
1010 :     =cut
1011 :    
1012 : overbeek 1.1 sub fid {
1013 :     my($self) = @_;
1014 :    
1015 :     return $self->{_fid};
1016 :     }
1017 :    
1018 : overbeek 1.4
1019 :    
1020 :     =head3 timestamp
1021 :    
1022 :     =cut
1023 :    
1024 : overbeek 1.1 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 : overbeek 1.4
1038 :    
1039 :     =head3 made_by
1040 :    
1041 :     =cut
1042 :    
1043 : overbeek 1.1 sub made_by {
1044 :     my($self) = @_;
1045 :    
1046 :     my $who = $self->{_who};
1047 :     $who =~ s/^master://i;
1048 :     return $who;
1049 :     }
1050 :    
1051 : overbeek 1.4
1052 :    
1053 :     =head3 text
1054 :    
1055 :     =cut
1056 :    
1057 : overbeek 1.1 sub text {
1058 :     my($self) = @_;
1059 :    
1060 :     my $text = $self->{_text};
1061 :     return $text;
1062 :     }
1063 :    
1064 : overbeek 1.4
1065 :     =head3 display
1066 :    
1067 :     =cut
1068 :    
1069 : overbeek 1.1 sub display {
1070 :     my($self) = @_;
1071 :    
1072 :     print join("\t",($self->fid,$self->timestamp(1),$self->made_by)),"\n",$self->text,"\n";
1073 :     }
1074 :    
1075 : overbeek 1.4
1076 :    
1077 :     ########################################################################
1078 : overbeek 1.1 package CouplingO;
1079 : overbeek 1.4 ########################################################################
1080 :     use Data::Dumper;
1081 :    
1082 :     =head3 new
1083 : overbeek 1.1
1084 : overbeek 1.4 =cut
1085 : overbeek 1.1
1086 :     sub new {
1087 :     my($class,$figO,$peg1,$peg2,$sc) = @_;
1088 :    
1089 :     ($peg1 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1090 :     ($peg2 =~ /^fig\|\d+\.\d+\.peg\.\d+$/) || return undef;
1091 :     my $self = {};
1092 :     $self->{_figO} = $figO;
1093 :     $self->{_peg1} = $peg1;
1094 :     $self->{_peg2} = $peg2;
1095 :     $self->{_sc} = $sc;
1096 :     return bless $self, $class;
1097 :     }
1098 :    
1099 : overbeek 1.4
1100 :    
1101 :     =head3 peg1
1102 :    
1103 :     =cut
1104 :    
1105 : overbeek 1.1 sub peg1 {
1106 :     my($self) = @_;
1107 :    
1108 : overbeek 1.5 my $figO = $self->{_figO};
1109 :     return new FeatureO($figO,$self->{_peg1});
1110 : overbeek 1.1 }
1111 :    
1112 : overbeek 1.4
1113 :    
1114 :     =head3 peg1
1115 :    
1116 :     =cut
1117 :    
1118 : overbeek 1.1 sub peg2 {
1119 :     my($self) = @_;
1120 :    
1121 : overbeek 1.5 my $figO = $self->{_figO};
1122 :     return new FeatureO($figO,$self->{_peg2});
1123 : overbeek 1.1 }
1124 :    
1125 : overbeek 1.4
1126 :    
1127 :     =head3 sc
1128 :    
1129 :     =cut
1130 :    
1131 : overbeek 1.1 sub sc {
1132 :     my($self) = @_;
1133 :    
1134 :     return $self->{_sc};
1135 :     }
1136 :    
1137 : overbeek 1.4
1138 :    
1139 :     =head3 evidence
1140 :    
1141 :     =cut
1142 :    
1143 : overbeek 1.1 sub evidence {
1144 :     my($self) = @_;
1145 :    
1146 :     my $figO = $self->{_figO};
1147 :     my $fig = $figO->{_fig};
1148 :     my @ev = ();
1149 :     foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))
1150 :     {
1151 :     my($peg3,$peg4,$rep) = @$tuple;
1152 :     push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
1153 :     &FeatureO::new('FeatureO',$figO,$peg4),
1154 :     $rep]);
1155 :     }
1156 :     return @ev;
1157 :     }
1158 :    
1159 : overbeek 1.4
1160 :    
1161 :     =head3 display
1162 :    
1163 :     =cut
1164 :    
1165 : overbeek 1.1 sub display {
1166 :     my($self) = @_;
1167 :    
1168 :     print join("\t",($self->peg1,$self->peg2,$self->sc)),"\n";
1169 :     }
1170 :    
1171 : overbeek 1.4
1172 :    
1173 :     ########################################################################
1174 : overbeek 1.1 package SubsystemO;
1175 : overbeek 1.4 ########################################################################
1176 : overbeek 1.1 use Data::Dumper;
1177 :     use Subsystem;
1178 :    
1179 : overbeek 1.4 =head1 SubsystemO
1180 :    
1181 :     =cut
1182 :    
1183 :    
1184 :    
1185 :     =head3 new
1186 :    
1187 :     =cut
1188 :    
1189 : overbeek 1.1 sub new {
1190 :     my($class,$figO,$name) = @_;
1191 :    
1192 :     my $self = {};
1193 :     $self->{_figO} = $figO;
1194 :     $self->{_id} = $name;
1195 :    
1196 :     return bless $self, $class;
1197 :     }
1198 :    
1199 : overbeek 1.4
1200 :    
1201 :     =head3 id
1202 :    
1203 :     =cut
1204 :    
1205 : overbeek 1.1 sub id {
1206 :     my($self) = @_;
1207 :    
1208 :     return $self->{_id};
1209 :     }
1210 :    
1211 : overbeek 1.4
1212 :    
1213 :     =head3 usable
1214 :    
1215 :     =cut
1216 :    
1217 : overbeek 1.1 sub usable {
1218 :     my($self) = @_;
1219 :    
1220 :     my $figO = $self->{_figO};
1221 :     my $fig = $figO->{_fig};
1222 :     return $fig->usable_subsystem($self->id);
1223 :     }
1224 :    
1225 : overbeek 1.4
1226 :    
1227 :     =head3 genomes
1228 :    
1229 :     =cut
1230 :    
1231 : overbeek 1.1 sub genomes {
1232 :     my($self) = @_;
1233 :    
1234 :     my $figO = $self->{_figO};
1235 :     my $subO = $self->{_subO};
1236 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1237 : overbeek 1.7 if (! defined($subO) { return undef }
1238 : overbeek 1.1
1239 :     return map { &GenomeO::new('GenomeO',$figO,$_) } $subO->get_genomes;
1240 :     }
1241 :    
1242 : overbeek 1.4
1243 :    
1244 :     =head3 roles
1245 :    
1246 :     =cut
1247 :    
1248 : overbeek 1.1 sub roles {
1249 :     my($self) = @_;
1250 :    
1251 :     my $figO = $self->{_figO};
1252 :     my $subO = $self->{_subO};
1253 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1254 : overbeek 1.7 if (! defined($subO) { return undef }
1255 : overbeek 1.1 return map { &FunctionalRoleO::new('FunctionalRoleO',$figO,$_) } $subO->get_roles($self->id);
1256 :     }
1257 :    
1258 : overbeek 1.4 =head3 curator
1259 :    
1260 :     =cut
1261 :    
1262 : overbeek 1.1 sub curator {
1263 :     my($self) = @_;
1264 :    
1265 :     my $figO = $self->{_figO};
1266 :     my $subO = $self->{_subO};
1267 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1268 :    
1269 : overbeek 1.7 return defined($subO) ? $subO->get_curator : undef;
1270 : overbeek 1.1 }
1271 :    
1272 : overbeek 1.4
1273 :    
1274 :    
1275 :     =head3 variant
1276 :    
1277 :     =cut
1278 :    
1279 : overbeek 1.1 sub variant {
1280 :     my($self,$genome) = @_;
1281 :    
1282 :     my $figO = $self->{_figO};
1283 :     my $subO = $self->{_subO};
1284 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1285 : overbeek 1.7 if (! defined($subO) { return undef }
1286 : overbeek 1.1
1287 :     return $subO->get_variant_code_for_genome($genome->id);
1288 :     }
1289 : overbeek 1.4
1290 :    
1291 :    
1292 :     =head3 pegs_in_cell
1293 :    
1294 :     =cut
1295 :    
1296 : overbeek 1.1 sub pegs_in_cell {
1297 :     my($self,$genome,$role) = @_;
1298 :    
1299 :     my $figO = $self->{_figO};
1300 :     my $subO = $self->{_subO};
1301 :     if (! $subO) { $subO = $self->{_subO} = new Subsystem($self->{_id},$figO->{_fig}); }
1302 : overbeek 1.7 if (! defined($subO) { return undef }
1303 : overbeek 1.1
1304 :     return $subO->get_pegs_from_cell($genome->id,$role->id);
1305 :     }
1306 :    
1307 : overbeek 1.4
1308 :    
1309 :     ########################################################################
1310 : overbeek 1.1 package FunctionalRoleO;
1311 : overbeek 1.4 ########################################################################
1312 :     use Data::Dumper;
1313 : overbeek 1.1
1314 : overbeek 1.4 =head1 FunctionalRoleO
1315 :    
1316 :     =cut
1317 :    
1318 :    
1319 :     =head3 new
1320 :    
1321 :     =cut
1322 : overbeek 1.1
1323 :     sub new {
1324 :     my($class,$figO,$fr) = @_;
1325 :    
1326 :     my $self = {};
1327 :     $self->{_figO} = $figO;
1328 :     $self->{_id} = $fr;
1329 :     return bless $self, $class;
1330 :     }
1331 :    
1332 : overbeek 1.4
1333 :    
1334 :     =head3 id
1335 :    
1336 :     =cut
1337 :    
1338 : overbeek 1.1 sub id {
1339 :     my($self) = @_;
1340 :    
1341 :     return $self->{_id};
1342 :     }
1343 :    
1344 : overbeek 1.4
1345 :    
1346 :     ########################################################################
1347 : overbeek 1.1 package FigFamO;
1348 : overbeek 1.4 ########################################################################
1349 : overbeek 1.1 use FigFams;
1350 :     use FigFam;
1351 :    
1352 : overbeek 1.4
1353 :     =head1 FigFamO
1354 :    
1355 :     =cut
1356 :    
1357 :    
1358 :     =head3 new
1359 :    
1360 :     =cut
1361 :    
1362 : overbeek 1.1 sub new {
1363 :     my($class,$figO,$id) = @_;
1364 :    
1365 :     my $self = {};
1366 :     $self->{_figO} = $figO;
1367 :     $self->{_id} = $id;
1368 :     return bless $self, $class;
1369 :     }
1370 :    
1371 : overbeek 1.4
1372 :    
1373 :     =head3 id
1374 :    
1375 :     =cut
1376 :    
1377 : overbeek 1.1 sub id {
1378 :     my($self) = @_;
1379 :    
1380 :     return $self->{_id};
1381 :     }
1382 :    
1383 : overbeek 1.4
1384 :     =head3 function
1385 :    
1386 :     =cut
1387 :    
1388 : overbeek 1.1 sub function {
1389 :     my($self) = @_;
1390 :    
1391 :     my $fig = $self->{_figO}->{_fig};
1392 :     my $famO = $self->{_famO};
1393 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1394 :    
1395 :     return $famO->family_function;
1396 :     }
1397 :    
1398 : overbeek 1.4
1399 :    
1400 :     =head3 members
1401 :    
1402 :     =cut
1403 :    
1404 : overbeek 1.1 sub members {
1405 :     my($self) = @_;
1406 :    
1407 :     my $figO = $self->{_figO};
1408 :     my $fig = $figO->{_fig};
1409 :     my $famO = $self->{_famO};
1410 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1411 :    
1412 :     return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;
1413 :     }
1414 :    
1415 : overbeek 1.4
1416 :    
1417 :     =head3 rep_seqs
1418 :    
1419 :     =cut
1420 :    
1421 : overbeek 1.1 sub rep_seqs {
1422 :     my($self) = @_;
1423 :    
1424 :     my $figO = $self->{_figO};
1425 :     my $fig = $figO->{_fig};
1426 :     my $famO = $self->{_famO};
1427 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1428 :    
1429 :     return $famO->representatives;
1430 :     }
1431 :    
1432 : overbeek 1.4
1433 :    
1434 :     =head3 should_be_member
1435 :    
1436 :     =cut
1437 :    
1438 : overbeek 1.1 sub should_be_member {
1439 :     my($self,$seq) = @_;
1440 :    
1441 :     my $figO = $self->{_figO};
1442 :     my $fig = $figO->{_fig};
1443 :     my $famO = $self->{_famO};
1444 :     if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
1445 :    
1446 :     return $famO->should_be_member($seq);
1447 :     }
1448 :    
1449 :    
1450 :    
1451 : overbeek 1.4 =head3 display
1452 :    
1453 :     =cut
1454 :    
1455 : overbeek 1.1 sub display {
1456 :     my($self) = @_;
1457 :    
1458 :     print join("\t",($self->id,$self->function)),"\n";
1459 :     }
1460 :    
1461 :    
1462 :    
1463 : overbeek 1.4 ########################################################################
1464 : overbeek 1.1 package Attribute;
1465 : overbeek 1.4 ########################################################################
1466 :     =head1 Attribute
1467 :    
1468 :     =cut
1469 : overbeek 1.1
1470 :     1;
1471 : overbeek 1.4 __END__
1472 :    
1473 :     =head1 Examples
1474 :    
1475 :     =head3 Display all complete, prokaryotic genomes
1476 :    
1477 :     use FIGO;
1478 :     my $figO = new FIGO;
1479 :    
1480 :     foreach $genome ($figO->genomes('complete','prokaryotic'))
1481 :     {
1482 :     $genome->display;
1483 :     }
1484 :    
1485 :     #---------------------------------------------
1486 :    
1487 :     use FIG;
1488 :     my $fig = new FIG;
1489 :    
1490 :     foreach $genome (grep { $fig->is_prokaryotic($_) } $fig->genomes('complete'))
1491 :     {
1492 :     print join("\t",("Genome",$genome,$fig->genus_species($genome))),"\n";
1493 :     }
1494 :    
1495 :     ###############################################
1496 :    
1497 :     =head3 Show how to access contigs and extract sequence
1498 :    
1499 :     use FIGO;
1500 :     my $figO = new FIGO;
1501 :    
1502 :     $genomeId = '83333.1';
1503 :     my $genome = new GenomeO($figO,$genomeId);
1504 :    
1505 :     foreach $contig ($genome->contigs_of)
1506 :     {
1507 :     $tag1 = $contig->dna_seq(1,10);
1508 :     $tag2 = $contig->dna_seq(10,1);
1509 :     print join("\t",($tag1,$tag2,$contig->id,$contig->contig_length)),"\n";
1510 :     }
1511 :    
1512 :     #---------------------------------------------
1513 :    
1514 :     use FIG;
1515 :     my $fig = new FIG;
1516 :    
1517 :     $genomeId = '83333.1';
1518 :    
1519 :     $contig_lengths = $fig->contig_lengths($genomeId);
1520 :    
1521 :     foreach $contig ($fig->contigs_of($genomeId))
1522 :     {
1523 :     $tag1 = $fig->dna_seq($genomeId,join("_",($contig,1,10)));
1524 :     $tag2 = $fig->dna_seq($genomeId,join("_",($contig,10,1)));
1525 :     print join("\t",($tag1,$tag2,$contig,$contig_lengths->{$contig})),"\n";
1526 :     }
1527 :    
1528 :     ###############################################
1529 :    
1530 :     ### accessing data related to features
1531 :    
1532 :     use FIGO;
1533 :     my $figO = new FIGO;
1534 :    
1535 :     my $genome = new GenomeO($figO,"83333.1");
1536 :     my $peg = "fig|83333.1.peg.4";
1537 :     my $pegO = new FeatureO($figO,$peg);
1538 :    
1539 :     print join("\t",$pegO->id,$pegO->location,$pegO->function_of),"\n",
1540 :     $pegO->dna_seq,"\n",
1541 :     $pegO->prot_seq,"\n";
1542 :    
1543 :     foreach $fidO ($genome->features_of('rna'))
1544 :     {
1545 :     print join("\t",$fidO->id,$fidO->location,$fidO->function_of),"\n";
1546 :     }
1547 :    
1548 :     #---------------------------------------------
1549 :    
1550 :    
1551 :     use FIG;
1552 :     my $fig = new FIG;
1553 :    
1554 :     my $genome = "83333.1";
1555 :     my $peg = "fig|83333.1.peg.4";
1556 :    
1557 :     print join("\t",$peg,scalar $fig->feature_location($peg),scalar $fig->function_of($peg)),"\n",
1558 :     $fig->dna_seq($genome,$fig->feature_location($peg)),"\n",
1559 :     $fig->get_translation($peg),"\n";
1560 :    
1561 :     foreach $fid ($fig->all_features($genome,'rna'))
1562 :     {
1563 :     print join("\t",$fid,scalar $fig->feature_location($fid),scalar $fig->function_of($fid)),"\n";
1564 :     }
1565 :    
1566 :     ###############################################
1567 :    
1568 :     ### accessing similarities
1569 :    
1570 :     use FIGO;
1571 :     my $figO = new FIGO;
1572 :    
1573 :     $peg = "fig|83333.1.peg.4";
1574 :     $pegO = new FeatureO($figO,$peg);
1575 :    
1576 :     @sims = $pegO->sims; # use sims( -all => 1, -max => 10000, -cutoff => 1.0e-20) to all
1577 :     # sims (including non-FIG sequences
1578 :     foreach $sim (@sims)
1579 :     {
1580 :     $peg2 = $sim->id2;
1581 :     $pegO2 = new FeatureO($figO,$peg2);
1582 :     $func = $pegO2->function_of;
1583 :     $sc = $sim->psc;
1584 :     print join("\t",($peg2,$sc,$func)),"\n";
1585 :     }
1586 :    
1587 :     #---------------------------------------------
1588 :    
1589 :    
1590 :     use FIG;
1591 :     my $fig = new FIG;
1592 :    
1593 :     $peg = "fig|83333.1.peg.4";
1594 :    
1595 :     @sims = $fig->sims($peg,1000,1.0e-5,"fig");
1596 :     foreach $sim (@sims)
1597 :     {
1598 :     $peg2 = $sim->id2;
1599 :     $func = $fig->function_of($peg2);
1600 :     $sc = $sim->psc;
1601 :     print join("\t",($peg2,$sc,$func)),"\n";
1602 :     }
1603 :    
1604 :     ###############################################
1605 :    
1606 :     ### accessing BBHs
1607 :    
1608 :     use FIGO;
1609 :     my $figO = new FIGO;
1610 :    
1611 :     $peg = "fig|83333.1.peg.4";
1612 :     $pegO = new FeatureO($figO,$peg);
1613 :    
1614 :     @bbhs = $pegO->bbhs;
1615 :     foreach $bbh (@bbhs)
1616 :     {
1617 :     $peg2 = $bbh->peg2;
1618 :     $pegO2 = new FeatureO($figO,$peg2);
1619 :     $func = $pegO2->function_of;
1620 :     $sc = $bbh->psc;
1621 :     print join("\t",($peg2,$sc,$func)),"\n";
1622 :     }
1623 :    
1624 :     #---------------------------------------------
1625 :    
1626 :     use FIG;
1627 :     my $fig = new FIG;
1628 :    
1629 :     $peg = "fig|83333.1.peg.4";
1630 :    
1631 :     @bbhs = $fig->bbhs($peg);
1632 :     foreach $bbh (@bbhs)
1633 :     {
1634 :     ($peg2,$sc,$bit_score) = @$bbh;
1635 :     $func = $fig->function_of($peg2);
1636 :     print join("\t",($peg2,$sc,$func)),"\n";
1637 :     }
1638 :    
1639 :     ###############################################
1640 :    
1641 :     ### accessing annotations
1642 :    
1643 :     use FIGO;
1644 :     my $figO = new FIGO;
1645 :    
1646 :     $peg = "fig|83333.1.peg.4";
1647 :     $pegO = new FeatureO($figO,$peg);
1648 :    
1649 :     @annotations = $pegO->annotations;
1650 :    
1651 :     foreach $ann (@annotations)
1652 :     {
1653 :     print join("\n",$ann->fid,$ann->timestamp(1),$ann->made_by,$ann->text),"\n\n";
1654 :     }
1655 :    
1656 :     #---------------------------------------------
1657 :    
1658 :     use FIG;
1659 :     my $fig = new FIG;
1660 :    
1661 :     $peg = "fig|83333.1.peg.4";
1662 :     @annotations = $fig->feature_annotations($peg);
1663 :     foreach $_ (@annotations)
1664 :     {
1665 :     (undef,$ts,$who,$text) = @$_;
1666 :     $who =~ s/master://i;
1667 :     print "$ts\n$who\n$text\n\n";
1668 :     }
1669 :    
1670 :     ###############################################
1671 :    
1672 :     ### accessing coupling data
1673 :    
1674 :    
1675 :     use FIGO;
1676 :     my $figO = new FIGO;
1677 :    
1678 :     my $peg = "fig|83333.1.peg.4";
1679 :     my $pegO = new FeatureO($figO,$peg);
1680 :     foreach $coupled ($pegO->coupled_to)
1681 :     {
1682 :     print join("\t",($coupled->peg1,$coupled->peg2,$coupled->sc)),"\n";
1683 :     foreach $tuple ($coupled->evidence)
1684 :     {
1685 :     my($peg3O,$peg4O,$rep) = @$tuple;
1686 :     print "\t",join("\t",($peg3O->id,$peg4O->id,$rep)),"\n";
1687 :     }
1688 :     print "\n";
1689 :     }
1690 :    
1691 :     #---------------------------------------------
1692 :    
1693 :    
1694 :     use FIG;
1695 :     my $fig = new FIG;
1696 :    
1697 :     my $peg1 = "fig|83333.1.peg.4";
1698 :     foreach $coupled ($fig->coupled_to($peg1))
1699 :     {
1700 :     ($peg2,$sc) = @$coupled;
1701 :     print join("\t",($peg1,$peg2,$sc)),"\n";
1702 :     foreach $tuple ($fig->coupling_evidence($peg1,$peg2))
1703 :     {
1704 :     my($peg3,$peg4,$rep) = @$tuple;
1705 :     print "\t",join("\t",($peg3,$peg4,$rep)),"\n";
1706 :     }
1707 :     print "\n";
1708 :     }
1709 :    
1710 :     ###############################################
1711 :    
1712 :     =head3 Accessing Subsystem data
1713 :    
1714 :     use FIGO;
1715 :     my $figO = new FIGO;
1716 :    
1717 :     foreach $sub ($figO->subsystems)
1718 :     {
1719 :     if ($sub->usable)
1720 :     {
1721 :     print join("\t",($sub->id,$sub->curator)),"\n";
1722 :    
1723 :     print "\tRoles\n";
1724 :     @roles = $sub->roles;
1725 :     foreach $role (@roles)
1726 :     {
1727 :     print "\t\t",join("\t",($role->id)),"\n";
1728 :     }
1729 :    
1730 :     print "\tGenomes\n";
1731 :     foreach $genome ($sub->genomes)
1732 :     {
1733 :     print "\t\t",join("\t",($sub->variant($genome),
1734 :     $genome->id,
1735 :     $genome->genus_species)),"\n";
1736 :     @pegs = ();
1737 :     foreach $role (@roles)
1738 :     {
1739 :     push(@pegs,$sub->pegs_in_cell($genome,$role));
1740 :     }
1741 :     print "\t\t\t",join(",",@pegs),"\n";
1742 :     }
1743 :     }
1744 :     }
1745 :    
1746 :     #---------------------------------------------
1747 :    
1748 :     use FIG;
1749 :     my $fig = new FIG;
1750 :    
1751 :     foreach $sub (grep { $fig->usable_subsystem($_) } $fig->all_subsystems)
1752 :     {
1753 :     $subO = new Subsystem($sub,$fig);
1754 :     $curator = $subO->get_curator;
1755 :     print join("\t",($sub,$curator)),"\n";
1756 :    
1757 :     print "\tRoles\n";
1758 :     @roles = $subO->get_roles;
1759 :     foreach $role (@roles)
1760 :     {
1761 :     print "\t\t",join("\t",($role)),"\n";
1762 :     }
1763 :    
1764 :     print "\tGenomes\n";
1765 :     foreach $genome ($subO->get_genomes)
1766 :     {
1767 :     print "\t\t",join("\t",($subO->get_variant_code_for_genome($genome),
1768 :     $genome,
1769 :     $fig->genus_species($genome))),"\n";
1770 :     foreach $role (@roles)
1771 :     {
1772 :     push(@pegs,$subO->get_pegs_from_cell($genome,$role));
1773 :     }
1774 :     print "\t\t\t",join(",",@pegs),"\n";
1775 :     }
1776 :     print "\n";
1777 :     }
1778 :    
1779 :     ###############################################
1780 :    
1781 :     =head3 Accessing FIGfams
1782 :    
1783 :     use FIGO;
1784 :     my $figO = new FIGO;
1785 :    
1786 :     foreach $fam ($figO->all_figfams)
1787 :     {
1788 :     print join("\t",($fam->id,$fam->function)),"\n";
1789 :     foreach $pegO ($fam->members)
1790 :     {
1791 :     $peg = $pegO->id;
1792 :     print "\t$peg\n";
1793 :     }
1794 :     }
1795 :    
1796 :     #---------------------------------------------
1797 :    
1798 :     use FIG;
1799 :     use FigFam;
1800 :     use FigFams;
1801 :    
1802 :     my $fig = new FIG;
1803 :     my $figfams = new FigFams($fig);
1804 :    
1805 :     foreach $fam ($figfams->all_families)
1806 :     {
1807 :     my $figfam = new FigFam($fig,$fam);
1808 :     print join("\t",($fam,$figfam->family_function)),"\n";
1809 :     foreach $peg ($figfam->list_members)
1810 :     {
1811 :     print "\t$peg\n";
1812 :     }
1813 :     }
1814 :    
1815 :     ###############################################
1816 :    
1817 :     =head3 Placing a sequence into a FIGfam
1818 :    
1819 :     use FIGO;
1820 :     my $figO = new FIGO;
1821 :    
1822 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1823 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1824 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1825 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1826 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1827 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1828 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1829 :     RKLMMNHQ";
1830 :     $seq =~ s/\n//gs;
1831 :    
1832 :     my($fam,$sims) = $figO->family_containing($seq);
1833 :    
1834 :     if ($fam)
1835 :     {
1836 :     print join("\t",($fam->id,$fam->function)),"\n";
1837 :     print &Dumper($sims);
1838 :     }
1839 :     else
1840 :     {
1841 :     print "Could not place it in a family\n";
1842 :     }
1843 :    
1844 :     #---------------------------------------------
1845 :    
1846 :     use FIG;
1847 :     use FigFam;
1848 :     use FigFams;
1849 :    
1850 :     my $fig = new FIG;
1851 :     my $figfams = new FigFams($fig);
1852 :    
1853 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1854 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1855 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1856 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1857 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1858 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1859 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1860 :     RKLMMNHQ";
1861 :     $seq =~ s/\n//gs;
1862 :    
1863 :     my($fam,$sims) = $figfams->place_in_family($seq);
1864 :    
1865 :     if ($fam)
1866 :     {
1867 :     print join("\t",($fam->family_id,$fam->family_function)),"\n";
1868 :     print &Dumper($sims);
1869 :     }
1870 :     else
1871 :     {
1872 :     print "Could not place it in a family\n";
1873 :     }
1874 :    
1875 :     ###############################################
1876 :    
1877 :     =head3 Getting representative sequences for a FIGfam
1878 :    
1879 :     use FIGO;
1880 :     my $figO = new FIGO;
1881 :    
1882 :     $fam = "FIG102446";
1883 :     my $famO = &FigFamO::new('FigFamO',$figO,$fam);
1884 :     my @rep_seqs = $famO->rep_seqs;
1885 :    
1886 :     foreach $seq (@rep_seqs)
1887 :     {
1888 :     print ">query\n$seq\n";
1889 :     }
1890 :    
1891 :     #---------------------------------------------
1892 :    
1893 :     use FIG;
1894 :     use FigFam;
1895 :     use FigFams;
1896 :    
1897 :     my $fig = new FIG;
1898 :    
1899 :     $fam = "FIG102446";
1900 :     my $famO = new FigFam($fig,$fam);
1901 :     my @rep_seqs = $famO->representatives;
1902 :    
1903 :     foreach $seq (@rep_seqs)
1904 :     {
1905 :     print ">query\n$seq\n";
1906 :     }
1907 :    
1908 :    
1909 :     ###############################################
1910 :    
1911 :    
1912 :     =head3 Testing for membership in FIGfam
1913 :    
1914 :     use FIGO;
1915 :     my $figO = new FIGO;
1916 :    
1917 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1918 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1919 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1920 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1921 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1922 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1923 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1924 :     RKLMMNHQ";
1925 :     $seq =~ s/\n//gs;
1926 :    
1927 :     $fam = "FIG102446";
1928 :     my $famO = &FigFamO::new('FigFamO',$figO,$fam);
1929 :     my($should_be, $sims) = $famO->should_be_member($seq);
1930 :    
1931 :     if ($should_be)
1932 :     {
1933 :     print join("\t",($famO->id,$famO->function)),"\n";
1934 :     print &Dumper($sims);
1935 :     }
1936 :     else
1937 :     {
1938 :     print "Sequence should not be added to family\n";
1939 :     }
1940 :    
1941 :     #---------------------------------------------
1942 :    
1943 :     use FIG;
1944 :     use FigFam;
1945 :     use FigFams;
1946 :    
1947 :     my $fig = new FIG;
1948 :    
1949 :     $seq = "MKLYNLKDHNEQVSFAQAVTQGLGKNQGLFFPHDLPEFSLTEIDEMLKLDFVTRSAKILS
1950 :     AFIGDEIPQEILEERVRAAFAFPAPVANVESDVGCLELFHGPTLAFKDFGGRFMAQMLTH
1951 :     IAGDKPVTILTATSGDTGAAVAHAFYGLPNVKVVILYPRGKISPLQEKLFCTLGGNIETV
1952 :     AIDGDFDACQALVKQAFDDEELKVALGLNSANSINISRLLAQICYYFEAVAQLPQETRNQ
1953 :     LVVSVPSGNFGDLTAGLLAKSLGLPVKRFIAATNVNDTVPRFLHDGQWSPKATQATLSNA
1954 :     MDVSQPNNWPRVEELFRRKIWQLKELGYAAVDDETTQQTMRELKELGYTSEPHAAVAYRA
1955 :     LRDQLNPGEYGLFLGTAHPAKFKESVEAILGETLDLPKELAERADLPLLSHNLPADFAAL
1956 :     RKLMMNHQ";
1957 :     $seq =~ s/\n//gs;
1958 :    
1959 :     $fam = "FIG102446";
1960 :     my $famO = new FigFam($fig,$fam);
1961 :     my($should_be, $sims) = $famO->should_be_member($seq);
1962 :    
1963 :     if ($should_be)
1964 :     {
1965 :     print join("\t",($famO->family_id,$famO->family_function)),"\n";
1966 :     print &Dumper($sims);
1967 :     }
1968 :     else
1969 :     {
1970 :     print "Sequence should not be added to family\n";
1971 :     }
1972 :    
1973 :     =cut
1974 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3