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

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3