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

Annotation of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3