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

Diff of /FigKernelPackages/FIGO.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15, Sun Mar 4 18:49:52 2007 UTC revision 1.30, Fri Nov 30 21:35:51 2007 UTC
# Line 17  Line 17 
17  #  #
18  ########################################################################  ########################################################################
19    
20    =head1 TODO
21    
22    =over 4
23    
24    =item Null arg to ContigO::dna_seq() should return entire contig seq.
25    
26    =item Add method to access "FIG::crude_estimate_of_distance()"
27    
28    =back
29    
30    =cut
31    
32  =head1 Overview  =head1 Overview
33    
34  This module is a set of packages encapsulating the SEED's core methods  This module is a set of packages encapsulating the SEED's core methods
35  using an "OOP-like" style.  using an "OOP-like" style.
36    
37  There are several modules clearly related to "individual genomes:"  There are several modules clearly related to "individual genomes:"
38  FIGO, GenomeO, ContigO, FeatureO (and I<maybe> AnnotationO).  GenomeO, ContigO, FeatureO (and I<maybe> AnnotationO).
39    
40  There are also modules that deal with complex relationships between  There are also modules that deal with complex relationships between
41  pairs or sets of features in one, two, or more genomes,  pairs or sets of features in one, two, or more genomes,
# Line 32  Line 44 
44    
45  Finally, the methods in "Attribute" might in principle attach  Finally, the methods in "Attribute" might in principle attach
46  "atributes" to any type of object.  "atributes" to any type of object.
47  (Likewise, in principle one might like to attach an "annotation"  (Likewise, in principle one might also want to attach an "annotation"
48  to any type of object  to any type of object,
49    although currently we only support annotations of "features.")
50    
51  Four of the modules dealing with "genomes" have a reasonable clear  The three modules that act on "individual genomes" have a reasonable clear
52  "implied heirarchy:"  "implied heirarchy" relative to FIGO:
53    
54  =over 4  =over 4
55    
# Line 52  Line 65 
65  We have chosen to in many cases sidestep the entire issue of inheritance  We have chosen to in many cases sidestep the entire issue of inheritance
66  via an I<ad hoc> mechanism:  via an I<ad hoc> mechanism:
67  If a "child" object needs access to its "ancestors'" methods,  If a "child" object needs access to its "ancestors'" methods,
68  we pass it references to its "ancestors" using subroutine arguments.  we will explicitly pass it references to its "ancestors,"
69    as subroutine arguments.
70  This is admittedly ugly, clumsy, and potentially error-prone ---  This is admittedly ugly, clumsy, and potentially error-prone ---
71  but it has the advantage that, unlike multiple inheritance,  but it has the advantage that, unlike multiple inheritance,
72  we understand how to do it...  we understand how to do it...
# Line 72  Line 86 
86  use SproutFIG;  use SproutFIG;
87  use Tracer;  use Tracer;
88  use Data::Dumper;  use Data::Dumper;
89    use Carp;
90  use FigFams;  use FigFams;
91  use gjoparseblast;  use gjoparseblast;
92    
# Line 117  Line 132 
132      return bless $self, $class;      return bless $self, $class;
133  }  }
134    
135    sub function_of {
136        my($self,$id) = @_;
137    
138        my $fig  = $self->{_fig};
139        my $func = $fig->function_of($id);
140    
141        return ($func ? $func : "");
142    }
143    
144  =head3 genomes  =head3 genomes
145    
# Line 312  Line 334 
334      }      }
335  }  }
336    
337    =head3 figfam
338    
339    =over 4
340    
341    =item USAGE:
342    
343    C<< my $fam = $figO->figfam($family_id); >>
344    
345    =item $family_id;
346    
347    A FigFam ID
348    
349    =item RETURNS:
350    
351    $fam:  A FIGfam Object.
352    
353    =back
354    
355    =cut
356    
357    sub figfam {
358        my($self,$fam_id) = @_;
359    
360        return &FigFamO::new('FigFamO',$self,$fam_id);
361    }
362    
363    
364  ########################################################################  ########################################################################
365  package GenomeO;  package GenomeO;
# Line 331  Line 379 
379    
380  =item USAGE:  =item USAGE:
381    
382  C<< my $org = GenomeO->new($figo, $tax_id); >>  C<< my $orgO = GenomeO->new($figO, $tax_id); >>
383    
384  =item RETURNS:  =item RETURNS:
385    
386      A new GenomeO object.  A new "GenomeO" object.
387    
388  =back  =back
389    
# Line 358  Line 406 
406    
407  =item USAGE:  =item USAGE:
408    
409  C<< my $tax_id = $org->id(); >>  C<< my $tax_id = $orgO->id(); >>
410    
411  =item RETURNS:  =item RETURNS:
412    
413      Taxonomy-ID of GenomeO object.  Taxonomy-ID of "GenomeO" object.
414    
415  =back  =back
416    
# Line 382  Line 430 
430    
431  =item USAGE:  =item USAGE:
432    
433  C<< $gs = $genome->genus_species(); >>  C<< $gs = $orgO->genus_species(); >>
434    
435  =item RETURNS:  =item RETURNS:
436    
# Line 400  Line 448 
448  }  }
449    
450    
451    
452    
453    =head3 taxonomy_of
454    
455    =over 4
456    
457    =item FUNCTION:
458    
459    Return the TAXONOMY string of a "GenomeO" object.
460    
461    =item USAGE:
462    
463    C<< my $taxonomy = $orgO->taxonomy_of(); >>
464    
465    =item RETURNS:
466    
467    TAXONOMY string.
468    
469    =back
470    
471    =cut
472    
473    sub taxonomy_of {
474        my ($self) = @_;
475    
476        my $figO = $self->{_figO};
477        my $fig  = $figO->{_fig};
478    
479        return $fig->taxonomy_of($self->{_id});
480    }
481    
482    
483  =head3 contigs_of  =head3 contigs_of
484    
485  =over 4  =over 4
# Line 428  Line 508 
508    
509  =head3 features_of  =head3 features_of
510    
511    =over 4
512    
513    =item FUNCTION:
514    
515    Returns a list of "FeatureO" objects contained in a "GenomeO" object.
516    
517    =item USAGE:
518    
519    C<< my @featureOs = $orgO->features_of();        #...Fetch all features >>
520    
521    or
522    
523    C<< my @featureOs = $orgO->features_of('peg');   #...Fetch only PEGs >>
524    
525    =item RETURNS:
526    
527    List of "FeatureO" objects.
528    
529    =back
530    
531  =cut  =cut
532    
533  sub features_of {  sub features_of {
# Line 606  Line 706 
706    
707  =item RETURNS:  =item RETURNS:
708    
709      string of DNA sequence running from $beg to $end  String containing DNA subsequence running from $beg to $end
710      (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)      (NOTE: if $beg > $end, returns reverse complement of DNA subsequence.)
711    
712  =back  =back
# Line 671  Line 771 
771  package FeatureO;  package FeatureO;
772  ########################################################################  ########################################################################
773  use Data::Dumper;  use Data::Dumper;
774    use Carp;
775    
776  =head1 FeatureO  =head1 FeatureO
777    
# Line 681  Line 782 
782    
783  =head3 new  =head3 new
784    
785  Constructor of "FeatureO" objects  Constructor of new "FeatureO" objects
786    
787  =over 4  =over 4
788    
# Line 751  Line 852 
852    
853  =item RETURNS:  =item RETURNS:
854    
855  The TAxon-ID for the "GenomeO" object containg the feature.  The Taxon-ID for the "GenomeO" object containing the feature.
856    
857  =back  =back
858    
# Line 989  Line 1090 
1090    
1091  =item RETURNS:  =item RETURNS:
1092    
1093  A list of L<CouplingO> objects describing the evidence for functional coupling  A list of "CouplingO" objects describing the evidence for functional coupling
1094  between this feature and other nearby features.  between this feature and other nearby features.
1095    
1096  =back  =back
# Line 1024  Line 1125 
1125    
1126  =item RETURNS:  =item RETURNS:
1127    
1128  A list of L<AnnotationO> objects allowing access to the annotations for this feature.  A list of "AnnotationO" objects allowing access to the annotations for this feature.
1129    
1130  =back  =back
1131    
# Line 1050  Line 1151 
1151    
1152  =item RETURNS:  =item RETURNS:
1153    
1154  A list of L<SubsystemO> objects allowing access to the subsystems  A list of "SubsystemO" objects allowing access to the subsystems
1155  that this feature particupates in.  that this feature particupates in.
1156    
1157  =back  =back
# Line 1116  Line 1217 
1217  sub possible_frameshift {  sub possible_frameshift {
1218      my($self) = @_;      my($self) = @_;
1219      my $figO = $self->{_figO};      my $figO = $self->{_figO};
1220        my $fig = $figO->{_fig};
1221      my($tmp_dir) = $figO->{_tmp_dir};      my($tmp_dir) = $figO->{_tmp_dir};
1222    
1223        my $tmp_dna  = "$tmp_dir/tmp_dna.$$.fasta";
1224        my $tmp_prot = "$tmp_dir/tmp_prot.$$.fasta";
1225    
1226        #...Skip tests and return '0' if truncated...
1227      if (! $self->possibly_truncated)      if (! $self->possibly_truncated)
1228      {      {
1229          my @sims = $self->sims( -max => 1, -cutoff => 1.0e-50);          #...Get best precomputed BLAST hit if E-value < 1.0e-20:
1230            my @sims = $self->sims( -max => 5, -cutoff => 1.0e-20);
1231            while ((@sims > 0) && $fig->possibly_truncated($sims[0]->id2)) { shift @sims }
1232    
1233            #...If a sim was returned:
1234          if (my $sim = shift @sims)          if (my $sim = shift @sims)
1235          {          {
1236                #...Get best hit FID and boundaries:
1237              my $peg2 = $sim->id2;              my $peg2 = $sim->id2;
1238              my $ln1  = $sim->ln1;              my $ln1  = $sim->ln1;
1239              my $ln2  = $sim->ln2;              my $ln2  = $sim->ln2;
1240              my $b2   = $sim->b2;              my $b2   = $sim->b2;
1241              my $e2   = $sim->e2;              my $e2   = $sim->e2;
1242    
1243                #...Convert from AA to BP, and pad out w/ 100 bp guard region:
1244              my $adjL = 100 + (($b2-1) * 3);              my $adjL = 100 + (($b2-1) * 3);
1245              my $adjR = 100 + (($ln2 - $e2) * 3);              my $adjR = 100 + (($ln2 - $e2) * 3);
1246    
1247                if ($ENV{DEBUG}) { print STDERR "adjL = $adjL adjR = $adjR ln1 = $ln1 peg2 = $peg2 ln2 = $ln2\n" }
1248                #...If hit is more than 20% longer than query:
1249              if ($ln2 > (1.2 * $ln1))              if ($ln2 > (1.2 * $ln1))
1250              {              {
1251                    #...Get and parse query location:
1252                  my $loc = $self->location;                  my $loc = $self->location;
1253                  if ($loc =~ /^(\S+)_(\d+)_(\d+)/)                  if ($loc =~ /^(\S+)_(\d+)_(\d+)/)
1254                  {                  {
1255                      my $contig = $1;                      my $contig = $1;
1256                      my $beg    = $2;                      my $beg    = $2;
1257                      my $end = $3;                      my $end = $3;
1258    
1259                        #...Create new ContigO object:
1260                      my $contigO = new ContigO($figO,$self->genome->id,$contig);                      my $contigO = new ContigO($figO,$self->genome->id,$contig);
1261                      my $begA = &max(1,$beg - $adjL);  
1262                      my $endA = &min($end+$adjR,$contigO->contig_length);                      #...Extract DNA subsequence, including guard regions:
1263                      my $dna  = $contigO->dna_seq($begA,$endA);                      my($begA,$endA,$dna);
1264                      open(TMP,">$tmp_dir/tmp_dna") || die "couild not open tmp_dna";                      if ($beg < $end)
1265                        {
1266                            $begA = &max(1, $beg - $adjL);
1267                            $endA = &min($end+$adjR, $contigO->contig_length);
1268                            $dna  = $contigO->dna_seq($begA,$endA);
1269                        }
1270                        else
1271                        {
1272                            $endA = &max(1, $beg - $adjL);
1273                            $begA = &min($end+$adjR, $contigO->contig_length);
1274                            $dna  = $contigO->dna_seq($begA,$endA);
1275                        }
1276    
1277                        if (defined($dna) && (length($dna) > 90))
1278                        {
1279                            #...Open tmp-file and write FASTA containing DNA subregion to be BLASTed:
1280                            open( TMP, ">$tmp_dna") || die "could not open $tmp_dna";
1281                      print TMP ">dna\n$dna\n";                      print TMP ">dna\n$dna\n";
1282                      close(TMP);                      close(TMP);
1283    
1284                      my $peg2O = new FeatureO($figO,$peg2);                          #...Create new FeatureO object corresponding tp $peg2:
1285                      my $prot  = $peg2O->prot_seq;                          my $pegO2 = new FeatureO($figO,$peg2);
1286                      open(TMP,">$tmp_dir/tmp_prot") || die "could not open tmp_prot";  
1287                            #...Fetch its translation, and print to tmp FASTA file for BLASTing:
1288                            my $prot  = $pegO2->prot_seq;
1289                            if (defined($prot) && (length($prot) > 30))
1290                            {
1291                                open( TMP, ">$tmp_prot") || die "could not open $tmp_prot";
1292                      print TMP ">tmp_prot\n$prot\n";                      print TMP ">tmp_prot\n$prot\n";
1293                      close(TMP);                      close(TMP);
1294                      &run("formatdb -i $tmp_dir/tmp_dna -pF");  
1295                      open(BLAST,"blastall -i $tmp_dir/tmp_prot -d $tmp_dir/tmp_dna -p tblastn -FF -e 1.0e-50 |")                              #...Build BLAST nucleotide database for extracted DNA region,
1296                                #   and TBLASTN $peg2 against the DNA:
1297                                &run("formatdb -i $tmp_dna -pF");
1298                                open(BLAST,"blastall -i $tmp_prot -d $tmp_dna -p tblastn -FF -e 1.0e-20 |")
1299                          || die "could not blast";                          || die "could not blast";
1300    
1301                                #...Parse the TBLASTN output; find and sort HSPs by left boundary:
1302                      my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);                      my $db_seq_out = &gjoparseblast::next_blast_subject(\*BLAST,1);
1303                                if ($ENV{DEBUG}) { print STDERR &Dumper(['blast output',$db_seq_out]) }
1304                      my @hsps       = sort { $a->[0] <=> $b->[0] }                      my @hsps       = sort { $a->[0] <=> $b->[0] }
1305                                       map { [$_->[9],$_->[10],$_->[12],$_->[13]] }                                       map { [$_->[9],$_->[10],$_->[12],$_->[13]] }
1306                                       grep { $_->[1] < 1.0e-50 }                                                grep { $_->[1] < 1.0e-20 }
1307                                       @{$db_seq_out->[6]};                                       @{$db_seq_out->[6]};
1308    
1309                                #...Extract HSP boundary pairs:
1310                      my @prot = map { [$_->[0],$_->[1]] } @hsps;                      my @prot = map { [$_->[0],$_->[1]] } @hsps;
1311                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;                      my @dna  = map { [$_->[2],$_->[3]] } @hsps;
1312                                if ($ENV{DEBUG}) { print STDERR &Dumper(\@prot,\@dna) }
1313    
1314                                #...If the "cover" of the HSPs covers more than 90% of $peg2 w gaps < 3 AA,
1315                                #   and the "cover" of the HPSs cover more than 90% of the extracted DNA
1316                                #   w/ gaps < 9 bp (but not a multiple of 3), suspect a possible frameshift:
1317                      if (&covers(\@prot,length($prot),3,0) && &covers(\@dna,3*length($prot),9,1))                      if (&covers(\@prot,length($prot),3,0) && &covers(\@dna,3*length($prot),9,1))
1318                      {                      {
1319                          return 1;                                  unlink($tmp_dna,$tmp_prot);
1320                                    return [$contig,$begA,$endA,$dna,$peg2];
1321                                }
1322                            }
1323                      }                      }
1324                  }                  }
1325              }              }
1326          }          }
1327      }      }
1328        unlink($tmp_dna,$tmp_prot);
1329      return 0;      return 0;
1330  }  }
1331    
# Line 1200  Line 1356 
1356    
1357  sub run {  sub run {
1358      my($cmd) = @_;      my($cmd) = @_;
1359      (system($cmd) == 0) || Confess("FAILED: $cmd");      (system($cmd) == 0) || confess("FAILED: $cmd");
1360  }  }
1361    
1362    
# Line 1215  Line 1371 
1371    
1372  C<< my $max = $feature->max($x, $y); >>  C<< my $max = $feature->max($x, $y); >>
1373    
1374  =item C<$x>  =item C<$x> and  C<$y>
1375    
1376  Numerical value.  Numerical values.
1377    
1378  =item C<$y>  =item RETURNS:
   
 Numerical value.  
   
 =items RETURNS:  
1379    
1380  The larger of the two numerical values C<$x> and C<$y>.  The larger of the two numerical values C<$x> and C<$y>.
1381    
# Line 1248  Line 1400 
1400    
1401  C<< my $min = $feature->min($x, $y); >>  C<< my $min = $feature->min($x, $y); >>
1402    
1403  =item C<$x>  =item C<$x> and C<$y>
1404    
1405  Numerical value.  Numerical values.
1406    
1407  =item C<$y>  =item RETURNS:
   
 Numerical value.  
   
 =items RETURNS:  
1408    
1409  The smaller of the two numerical values C<$x> and C<$y>.  The smaller of the two numerical values C<$x> and C<$y>.
1410    
# Line 1273  Line 1421 
1421    
1422  =head3 covers  =head3 covers
1423    
1424    (Question: Should this function be considered "PRIVATE" ???)
1425    
1426    USAGE:
1427        C<< if (&covers(\@hits, $len, $diff, $must_shift)) { #...Do stuff } >>
1428    
1429    Returns boolean C<TRUE> if a set of BLAST HSPs "cover" more than 90%
1430    of the database sequence(?).
1431    
1432  =cut  =cut
1433    
1434  sub covers {  sub covers {
1435      my($hsps,$ln,$diff,$must_shift) = @_;      my($hsps,$ln,$diff,$must_shift) = @_;
1436    
1437        if ($ENV{DEBUG}) { print STDERR &Dumper(['hsps',$hsps,'ln',$ln,'diff',$diff,'must_shift',$must_shift]) }
1438      my $hsp1 = shift @$hsps;      my $hsp1 = shift @$hsps;
1439      my $hsp2;      my $hsp2;
1440      my $merged = 0;      my $merged = 0;
1441      while ($hsp1 && ($hsp2 = shift @$hsps) &&      while ($hsp1 && ($hsp2 = shift @$hsps) &&
1442             ($must_shift ? &diff_frames($hsp1,$hsp2) : 1) &&             ($must_shift ? &diff_frames($hsp1,$hsp2) : 1) &&
1443             ($hsp1 = &merge($hsp1,$hsp2,$diff))) { $merged = 1 }             ($hsp1 = &merge($hsp1,$hsp2,$diff)))
1444        {
1445            $merged = 1;
1446            if ($ENV{DEBUG}) { print STDERR &Dumper(['merged',$hsp1]) }
1447        }
1448      return ($merged && $hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));      return ($merged && $hsp1 && (($hsp1->[1] - $hsp1->[0]) > (0.9 * $ln)));
1449  }  }
1450    
1451  sub diff_frames {  sub diff_frames {
1452      my($hsp1,$hsp2) = @_;      my($hsp1,$hsp2) = @_;
1453      return (($hsp1->[0] % 3) != ($hsp2->[0] % 3));      return ((($hsp1->[1]+1) % 3) != ($hsp2->[0] % 3));
1454  }  }
1455    
1456    
1457    
1458  =head3 merge  =head3 merge
1459    
1460    Merge two HSPs unless their overlap or separation is too large.
1461    
1462    RETURNS: Merged boundaries if merger succeeds, and C<undef> if merger fails.
1463    
1464  =cut  =cut
1465    
1466  sub merge {  sub merge {
# Line 1301  Line 1468 
1468    
1469      my($b1,$e1) = @$hsp1;      my($b1,$e1) = @$hsp1;
1470      my($b2,$e2) = @$hsp2;      my($b2,$e2) = @$hsp2;
1471      return (($e2 > $e1) && (abs($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;      return (($e2 > $e1) && (($b2-$e1) <= $diff)) ? [$b1,$e2] : undef;
1472  }  }
1473    
1474    
1475    
1476  =head3 sims  =head3 sims
1477    
1478    =over 4
1479    
1480    =item FUNCTION:
1481    
1482    Returns precomputed "Sim.pm" objects from the SEED.
1483    
1484    =item USAGE:
1485    
1486    C<< my @sims = $pegO->sims( -all, -cutoff => 1.0e-10); >>
1487    
1488    C<< my @sims = $pegO->sims( -max => 50, -cutoff => 1.0e-10); >>
1489    
1490    =item RETURNS: List of sim objects.
1491    
1492    =back
1493    
1494  =cut  =cut
1495    
1496  use Sim;  use Sim;
# Line 1318  Line 1501 
1501      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
1502    
1503      my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;      my $cutoff = $args{-cutoff} ? $args{-cutoff} : 1.0e-5;
1504      my $all    = $args{-all}    ? $args{-all}    : "fig";      my $all    = $args{-all}    ? 'all'          : "fig";
1505      my $max    = $args{-max}    ? $args{-max}    : 10000;      my $max    = $args{-max}    ? $args{-max}    : 10000;
1506    
1507      return $fig->sims($self->id,$max,$cutoff,$all);      my @sims = $fig->sims($self->id,$max,$cutoff,$all);
1508    
1509        if (@sims) {
1510            my $peg1 = FeatureO->new($figO, $sims[0]->[0]);
1511    
1512            foreach my $sim (@sims) {
1513    #           $sim->[0] = $peg1;
1514    #           $sim->[1] = FeatureO->new($figO, $sim->[1]);
1515            }
1516        }
1517    
1518        return @sims;
1519  }  }
1520    
1521    
1522    
1523  =head3 bbhs  =head3 bbhs
1524    
1525    =over 4
1526    
1527    =item FUNCTION:
1528    
1529    Given a PEG-type "FeatureO" object, returns the list of BBHO objects
1530    corresponding to the pre-computed BBHs for that PEG.
1531    
1532    =item USAGE:
1533    
1534    C<< my @bbhs = $pegO->bbhs(); >>
1535    
1536    =item RETURNS:
1537    
1538    List of BBHO objects.
1539    
1540    =back
1541    
1542  =cut  =cut
1543    
1544  sub bbhs {  sub bbhs {
# Line 1345  Line 1556 
1556                                                  },'BBHO') } @bbhs;                                                  },'BBHO') } @bbhs;
1557  }  }
1558    
1559    
1560  =head3 display  =head3 display
1561    
1562    =over 4
1563    
1564    =item FUNCTION:
1565    
1566    Prints info about a "FeatureO" object to STDOUT.
1567    
1568    =item USAGE:
1569    
1570    C<< $pegO->display(); >>
1571    
1572    =item RETURNS;
1573    
1574    (void)
1575    
1576    =back
1577    
1578  =cut  =cut
1579    
1580  sub display {  sub display {
# Line 1365  Line 1593 
1593    
1594  =head1 BBHO  =head1 BBHO
1595    
1596    Methods for accessing "Bidirectiona Best Hits" (BBHs).
1597    
1598  =cut  =cut
1599    
1600    
1601  =head3 new  =head3 new
1602    
1603    Constructor of BBHO objects.
1604    
1605    (NOTE: The "average user" should never need to invoke this method.)
1606    
1607  =cut  =cut
1608    
1609  sub new {  sub new {
# Line 1385  Line 1619 
1619  }  }
1620    
1621    
1622    
1623  =head3 peg1  =head3 peg1
1624    
1625    =over 4
1626    
1627    =item USAGE:
1628    
1629    C<< my $peg1 = $bbh->peg1(); >>
1630    
1631    =item RETURNS:
1632    
1633    A "FeatureO" object corresponding to the "query" sequence
1634    in a BBH pair.
1635    
1636    =back
1637    
1638  =cut  =cut
1639    
1640  sub peg1 {  sub peg1 {
# Line 1398  Line 1646 
1646    
1647  =head3 peg2  =head3 peg2
1648    
1649    =over 4
1650    
1651    =item USAGE:
1652    
1653    C<< my $peg2 = $bbh->peg2(); >>
1654    
1655    =item RETURNS:
1656    
1657    A "FeatureO" object corresponding to the "database" sequence
1658    in a BBH pair.
1659    
1660    =back
1661    
1662  =cut  =cut
1663    
1664  sub peg2 {  sub peg2 {
# Line 1411  Line 1672 
1672    
1673  =head3 psc  =head3 psc
1674    
1675    =over 4
1676    
1677    =item USAGE:
1678    
1679    C<< my $psc = $bbh->psc(); >>
1680    
1681    =item RETURNS:
1682    
1683    The numerical value of the BLAST E-value for the pair.
1684    
1685    =back
1686    
1687  =cut  =cut
1688    
1689  sub psc {  sub psc {
# Line 1423  Line 1696 
1696    
1697  =head3 norm_bitscore  =head3 norm_bitscore
1698    
1699    
1700    =over 4
1701    
1702    =item USAGE:
1703    
1704    C<< my $bsc = $bbh->norm_bitscore(); >>
1705    
1706    =item RETURNS:
1707    
1708    The "BLAST bit-score per aligned character" for the pair.
1709    
1710    =back
1711    
1712  =cut  =cut
1713    
1714  sub norm_bitscore {  sub norm_bitscore {
# Line 1439  Line 1725 
1725    
1726  =head1 AnnotationO  =head1 AnnotationO
1727    
1728    Methods for accessing SEED annotations.
1729    
1730  =cut  =cut
1731    
1732    
1733    
1734  =head3 new  =head3 new
1735    
1736    =over 4
1737    
1738    =item FUNCTION:
1739    
1740    Cronstruct a new "AnnotationO" object
1741    
1742    =item USAGE:
1743    
1744    C<< my $annotO = AnnotationO->new( $fid, $timestamp, $who, $text); >>
1745    
1746    =item C<$fid>
1747    
1748    A feature identifier.
1749    
1750    =item C<$timestamp>
1751    
1752    The C<UN*X> timestamp one wishes to associate with the annotation.
1753    
1754    =item C<$who>
1755    
1756    The annotator's user-name.
1757    
1758    =item C<$text>
1759    
1760    The textual content of the annotation.
1761    
1762    =item RETURNS:
1763    
1764    An "AnnotationO" object.
1765    
1766    =back
1767    
1768  =cut  =cut
1769    
1770  sub new {  sub new {
# Line 1462  Line 1782 
1782    
1783  =head3 fid  =head3 fid
1784    
1785    =over 4
1786    
1787    =item FUNCTION:
1788    
1789    Extract the feature-ID that was annotated.
1790    
1791    =item USAGE:
1792    
1793    C<< my $fid = $annotO->fid(); >>
1794    
1795    =item RETURNS;
1796    
1797    The feature-ID as a string.
1798    
1799    =back
1800    
1801  =cut  =cut
1802    
1803  sub fid {  sub fid {
# Line 1474  Line 1810 
1810    
1811  =head3 timestamp  =head3 timestamp
1812    
1813    =over 4
1814    
1815    =item FUNCTION:
1816    
1817    Extract the C<UN*X> timestamp of the annotation.
1818    
1819    =item USAGE:
1820    
1821    C<< my $fid = $annotO->timestamp(); >>
1822    
1823    =item RETURNS;
1824    
1825    The timestamp as a string.
1826    
1827    =back
1828    
1829  =cut  =cut
1830    
1831  sub timestamp {  sub timestamp {
# Line 1493  Line 1845 
1845    
1846  =head3 made_by  =head3 made_by
1847    
1848    =over 4
1849    
1850    =item FUNCTION:
1851    
1852    Extract the annotator's user-name.
1853    
1854    =item USAGE:
1855    
1856    C<< my $fid = $annotO->made_by(); >>
1857    
1858    =item RETURNS;
1859    
1860    The username of the annotator, as a string.
1861    
1862    =back
1863    
1864  =cut  =cut
1865    
1866  sub made_by {  sub made_by {
# Line 1507  Line 1875 
1875    
1876  =head3 text  =head3 text
1877    
1878    =over 4
1879    
1880    =item FUNCTION:
1881    
1882    Extract the text of the annotation.
1883    
1884    =item USGAE:
1885    
1886    C<< my $text = $annotO->text(); >>
1887    
1888    =item RETURNS:
1889    
1890    The text of the annotation, as a string.
1891    
1892    =back
1893    
1894  =cut  =cut
1895    
1896  sub text {  sub text {
# Line 1519  Line 1903 
1903    
1904  =head3 display  =head3 display
1905    
1906    =over 4
1907    
1908    =item FUNCTION:
1909    
1910    Print the contents of an "AnnotationO" object to B<STDOUT>
1911    in human-readable form.
1912    
1913    =item USAGE:
1914    
1915    C<< my $annotO->display(); >>
1916    
1917    =item RETURNS:
1918    
1919    (void)
1920    
1921    =back
1922    
1923  =cut  =cut
1924    
1925  sub display {  sub display {
# Line 1536  Line 1937 
1937    
1938  =head1 CouplingO  =head1 CouplingO
1939    
1940    Methods for accessing the "Functional coupling scores"
1941    of PEGs in close physical proximity to each other.
1942    
1943  =cut  =cut
1944    
1945    
1946    
1947  =head3 new  =head3 new
1948    
1949    =over 4
1950    
1951    =item FUNCTION:
1952    
1953    Construct a new "CouplingO" object
1954    encapsulating the "functional coupling" score
1955    between a pair of features in some genome.
1956    
1957    =item USAGE:
1958    
1959    C<< $couplingO = CouplingO->new($figO, $fid1, $fid2, $sc); >>
1960    
1961    =item C<$figO>
1962    
1963    Parent "FIGO" object.
1964    
1965    =item C<$fid1> and C<$fid2>
1966    
1967    A pair of feature-IDs.
1968    
1969    =item C<$sc>
1970    
1971    A functional-coupling score
1972    
1973    =item RETURNS:
1974    
1975    A "CouplingO" object.
1976    
1977    =back
1978    
1979  =cut  =cut
1980    
1981  sub new {  sub new {
# Line 1561  Line 1995 
1995    
1996  =head3 peg1  =head3 peg1
1997    
1998    =over 4
1999    
2000    =item FUNCTION:
2001    
2002    Returns a "FeatureO" object corresponding to the first FID in a coupled pair.
2003    
2004    =item USAGE:
2005    
2006    C<< my $peg1 = $couplingO->peg1(); >>
2007    
2008    =item RETURNS:
2009    
2010    A "FeatureO" object.
2011    
2012    =back
2013    
2014  =cut  =cut
2015    
2016  sub peg1 {  sub peg1 {
# Line 1572  Line 2022 
2022    
2023    
2024    
2025  =head3 peg1  =head3 peg2
2026    
2027    =over 4
2028    
2029    =item FUNCTION:
2030    
2031    Returns a "FeatureO" object corresponding to the second FID in a coupled pair.
2032    
2033    =item USAGE:
2034    
2035    C<< my $peg2 = $couplingO->peg2(); >>
2036    
2037    =item RETURNS:
2038    
2039    A "FeatureO" object.
2040    
2041    =back
2042    
2043  =cut  =cut
2044    
# Line 1587  Line 2053 
2053    
2054  =head3 sc  =head3 sc
2055    
2056    =over 4
2057    
2058    =item FUNCTION:
2059    
2060    Extracts the "functional coupling" score from a "CouplingO" object.
2061    
2062    =item USAGE:
2063    
2064    C<< my $sc = $couplingO->sc(); >>
2065    
2066    =item RETURNS:
2067    
2068    A scalar score.
2069    
2070    =back
2071    
2072  =cut  =cut
2073    
2074  sub sc {  sub sc {
# Line 1599  Line 2081 
2081    
2082  =head3 evidence  =head3 evidence
2083    
2084    =over 4
2085    
2086    =item FUNCTION:
2087    
2088    Fetch the evidence for a "functional coupling" between two close PEGs,
2089    in the form of a list of objects describing the "Pairs of Close Homologs" (PCHs)
2090    supporting the existence of a functional coupling between the two close PEGs.
2091    
2092    =item USAGE:
2093    
2094    C<< my $evidence = $couplingO->evidence(); >>
2095    
2096    =item RETURNS
2097    
2098    List of pairs of "FeatureO" objects.
2099    
2100    =back
2101    
2102  =cut  =cut
2103    
2104  sub evidence {  sub evidence {
# Line 1607  Line 2107 
2107      my $figO = $self->{_figO};      my $figO = $self->{_figO};
2108      my $fig  = $figO->{_fig};      my $fig  = $figO->{_fig};
2109      my @ev = ();      my @ev = ();
2110      foreach my $tuple ($fig->coupling_evidence($self->peg1,$self->peg2))      foreach my $tuple ($fig->coupling_evidence($self->peg1->id,$self->peg2->id))
2111      {      {
2112          my($peg3,$peg4,$rep) = @$tuple;          my($peg3,$peg4,$rep) = @$tuple;
2113          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),          push(@ev,[&FeatureO::new('FeatureO',$figO,$peg3),
# Line 1621  Line 2121 
2121    
2122  =head3 display  =head3 display
2123    
2124    =over 4
2125    
2126    =item FUNCTION:
2127    
2128    Print the contents of a "CouplingO" object to B<STDOUT> in human-readable form.
2129    
2130    =item USAGE:
2131    
2132    C<< $couplingO->display(); >>
2133    
2134    =item RETURNS:
2135    
2136    (Void)
2137    
2138    =back
2139    
2140  =cut  =cut
2141    
2142  sub display {  sub display {
# Line 1673  Line 2189 
2189    
2190  =head3 usable  =head3 usable
2191    
2192    
2193  =cut  =cut
2194    
2195  sub usable {  sub usable {
# Line 1871  Line 2388 
2388      my $famO = $self->{_famO};      my $famO = $self->{_famO};
2389      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }      if (! $famO) { $famO = $self->{_famO} = &FigFam::new('FigFam',$fig,$self->id) }
2390    
2391      return map { &FigFamO::new('FigFamO',$figO,$_) } $famO->list_members;      return map { &FeatureO::new('FeatureO',$figO,$_) } $famO->list_members;
2392  }  }
2393    
   
   
2394  =head3 rep_seqs  =head3 rep_seqs
2395    
2396  =cut  =cut

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.30

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3