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

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3