[Bio] / Sprout / Sprout.pm Repository:
ViewVC logotype

Diff of /Sprout/Sprout.pm

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

revision 1.99, Fri Apr 27 22:21:46 2007 UTC revision 1.100, Mon Jul 16 19:59:50 2007 UTC
# Line 134  Line 134 
134      $retVal->{_xmlName} = $xmlFileName;      $retVal->{_xmlName} = $xmlFileName;
135      # Set up space for the group file data.      # Set up space for the group file data.
136      $retVal->{groupHash} = undef;      $retVal->{groupHash} = undef;
137        # Set up space for the genome hash. We use this to identify NMPDR genomes.
138        $retVal->{genomeHash} = undef;
139      # Connect to the attributes.      # Connect to the attributes.
140      if ($FIG_Config::attrURL) {      if ($FIG_Config::attrURL) {
141          Trace("Remote attribute server $FIG_Config::attrURL chosen.") if T(3);          Trace("Remote attribute server $FIG_Config::attrURL chosen.") if T(3);
# Line 573  Line 575 
575  =back  =back
576    
577  =cut  =cut
578  #: Return Type @;  
 #: Return Type $;  
579  sub FeatureLocation {  sub FeatureLocation {
580      # Get the parameters.      # Get the parameters.
581      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
582      # Create a query for the feature locations.      # Get the feature record.
583      my $query = $self->Get(['IsLocatedIn'], "IsLocatedIn(from-link) = ? ORDER BY IsLocatedIn(locN)",      my $object = $self->GetEntity('Feature', $featureID);
584                             [$featureID]);      Confess("Feature $featureID not found.") if ! defined($object);
585        # Get the location string.
586        my $locString = $object->PrimaryValue('Feature(location-string)');
587      # Create the return list.      # Create the return list.
588      my @retVal = ();      my @retVal = split /\s*,\s*/, $locString;
     # Set up the variables used to determine if we have adjacent segments. This initial setup will  
     # not match anything.  
     my ($prevContig, $prevBeg, $prevDir, $prevLen) = ("", 0, "0", 0);  
     # Loop through the query results, creating location specifiers.  
     while (my $location = $query->Fetch()) {  
         # Get the location parameters.  
         my ($contigID, $beg, $dir, $len) = $location->Values(['IsLocatedIn(to-link)',  
             'IsLocatedIn(beg)', 'IsLocatedIn(dir)', 'IsLocatedIn(len)']);  
         # Check to see if we are adjacent to the previous segment.  
         if ($prevContig eq $contigID && $dir eq $prevDir) {  
             # Here the new segment is in the same direction on the same contig. Insure the  
             # new segment's beginning is next to the old segment's end.  
             if ($dir eq "-" && $beg + $len == $prevBeg) {  
                 # Here we're merging two backward blocks, so we keep the new begin point  
                 # and adjust the length.  
                 $len += $prevLen;  
                 # Pop the old segment off. The new one will replace it later.  
                 pop @retVal;  
             } elsif ($dir eq "+" && $beg == $prevBeg + $prevLen) {  
                 # Here we need to merge two forward blocks. Adjust the beginning and  
                 # length values to include both segments.  
                 $beg = $prevBeg;  
                 $len += $prevLen;  
                 # Pop the old segment off. The new one will replace it later.  
                 pop @retVal;  
             }  
         }  
         # Remember this specifier for the adjacent-segment test the next time through.  
         ($prevContig, $prevBeg, $prevDir, $prevLen) = ($contigID, $beg, $dir, $len);  
         # Compute the initial base pair.  
         my $start = ($dir eq "+" ? $beg : $beg + $len - 1);  
         # Add the specifier to the list.  
         push @retVal, "${contigID}_$start$dir$len";  
     }  
589      # Return the list in the format indicated by the context.      # Return the list in the format indicated by the context.
590      return (wantarray ? @retVal : join(',', @retVal));      return (wantarray ? @retVal : join(',', @retVal));
591  }  }
# Line 642  Line 611 
611  =back  =back
612    
613  =cut  =cut
614  #: Return Type @;  
615  sub ParseLocation {  sub ParseLocation {
616      # Get the parameter. Note that if we're called as an instance method, we ignore      # Get the parameter. Note that if we're called as an instance method, we ignore
617      # the first parameter.      # the first parameter.
# Line 698  Line 667 
667  =back  =back
668    
669  =cut  =cut
670  #: Return Type $;  
671  sub PointLocation {  sub PointLocation {
672      # Get the parameter. Note that if we're called as an instance method, we ignore      # Get the parameter. Note that if we're called as an instance method, we ignore
673      # the first parameter.      # the first parameter.
# Line 1064  Line 1033 
1033  =back  =back
1034    
1035  =cut  =cut
1036  #: Return Type @@;  
1037  sub GenesInRegion {  sub GenesInRegion {
1038      # Get the parameters.      # Get the parameters.
1039      my ($self, $contigID, $start, $stop) = @_;      my ($self, $contigID, $start, $stop) = @_;
1040      # Get the maximum segment length.      # Get the maximum segment length.
1041      my $maximumSegmentLength = $self->MaxSegment;      my $maximumSegmentLength = $self->MaxSegment;
     # Create a hash to receive the feature list. We use a hash so that we can eliminate  
     # duplicates easily. The hash key will be the feature ID. The value will be a two-element  
     # containing the minimum and maximum offsets. We will use the offsets to sort the results  
     # when we're building the result set.  
     my %featuresFound = ();  
1042      # Prime the values we'll use for the returned beginning and end.      # Prime the values we'll use for the returned beginning and end.
1043      my @initialMinMax = ($self->ContigLength($contigID), 0);      my @initialMinMax = ($self->ContigLength($contigID), 0);
1044      my ($min, $max) = @initialMinMax;      my ($min, $max) = @initialMinMax;
1045      # Create a table of parameters for each query. Each query looks for features travelling in      # Get the overlapping features.
1046        my @featureObjects = $self->GeneDataInRegion($contigID, $start, $stop);
1047        # We'l use this hash to help us track the feature IDs and sort them. The key is the
1048        # feature ID and the value is a [$left,$right] pair indicating the maximum extent
1049        # of the feature's locations.
1050        my %featureMap = ();
1051        # Loop through them to do the begin/end analysis.
1052        for my $featureObject (@featureObjects) {
1053            # Get the feature's location string. This may contain multiple actual locations.
1054            my ($locations, $fid) = $featureObject->Values([qw(Feature(location-string) Feature(id))]);
1055            my @locationSegments = split /\s*,\s*/, $locations;
1056            # Loop through the locations.
1057            for my $locationSegment (@locationSegments) {
1058                # Construct an object for the location.
1059                my $locationObject = BasicLocation->new($locationSegment);
1060                # Merge the current segment's begin and end into the min and max.
1061                my ($left, $right) = ($locationObject->Left, $locationObject->Right);
1062                my ($beg, $end);
1063                if (exists $featureMap{$fid}) {
1064                    ($beg, $end) = @{$featureMap{$fid}};
1065                    $beg = $left if $left < $beg;
1066                    $end = $right if $right > $end;
1067                } else {
1068                    ($beg, $end) = ($left, $right);
1069                }
1070                $min = $beg if $beg < $min;
1071                $max = $end if $end > $max;
1072                # Store the feature's new extent back into the hash table.
1073                $featureMap{$fid} = [$beg, $end];
1074            }
1075        }
1076        # Now we must compute the list of the IDs for the features found. We start with a list
1077        # of midpoints / feature ID pairs. (It's not really a midpoint, it's twice the midpoint,
1078        # but the result of the sort will be the same.)
1079        my @list = map { [$featureMap{$_}->[0] + $featureMap{$_}->[1], $_] } keys %featureMap;
1080        # Now we sort by midpoint and yank out the feature IDs.
1081        my @retVal = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @list;
1082        # Return it along with the min and max.
1083        return (\@retVal, $min, $max);
1084    }
1085    
1086    =head3 GeneDataInRegion
1087    
1088    C<< my @featureList = $sprout->GenesInRegion($contigID, $start, $stop); >>
1089    
1090    List the features which overlap a specified region in a contig.
1091    
1092    =over 4
1093    
1094    =item contigID
1095    
1096    ID of the contig containing the region of interest.
1097    
1098    =item start
1099    
1100    Offset of the first residue in the region of interest.
1101    
1102    =item stop
1103    
1104    Offset of the last residue in the region of interest.
1105    
1106    =item RETURN
1107    
1108    Returns a list of B<ERDBObjects> for the desired features. Each object will
1109    contain a B<Feature> record.
1110    
1111    =back
1112    
1113    =cut
1114    
1115    sub GeneDataInRegion {
1116        # Get the parameters.
1117        my ($self, $contigID, $start, $stop) = @_;
1118        # Get the maximum segment length.
1119        my $maximumSegmentLength = $self->MaxSegment;
1120        # Create a hash to receive the feature list. We use a hash so that we can eliminate
1121        # duplicates easily. The hash key will be the feature ID. The value will be the feature's
1122        # ERDBObject from the query.
1123        my %featuresFound = ();
1124        # Create a table of parameters for the queries. Each query looks for features travelling in
1125      # a particular direction. The query parameters include the contig ID, the feature direction,      # a particular direction. The query parameters include the contig ID, the feature direction,
1126      # the lowest possible start position, and the highest possible start position. This works      # the lowest possible start position, and the highest possible start position. This works
1127      # because each feature segment length must be no greater than the maximum segment length.      # because each feature segment length must be no greater than the maximum segment length.
# Line 1087  Line 1130 
1130      # Loop through the query parameters.      # Loop through the query parameters.
1131      for my $parms (values %queryParms) {      for my $parms (values %queryParms) {
1132          # Create the query.          # Create the query.
1133          my $query = $self->Get(['IsLocatedIn'],          my $query = $self->Get([qw(Feature IsLocatedIn)],
1134              "IsLocatedIn(to-link)= ? AND IsLocatedIn(dir) = ? AND IsLocatedIn(beg) >= ? AND IsLocatedIn(beg) <= ?",              "IsLocatedIn(to-link)= ? AND IsLocatedIn(dir) = ? AND IsLocatedIn(beg) >= ? AND IsLocatedIn(beg) <= ?",
1135              $parms);              $parms);
1136          # Loop through the feature segments found.          # Loop through the feature segments found.
1137          while (my $segment = $query->Fetch) {          while (my $segment = $query->Fetch) {
1138              # Get the data about this segment.              # Get the data about this segment.
1139              my ($featureID, $dir, $beg, $len) = $segment->Values(['IsLocatedIn(from-link)',              my ($featureID, $contig, $dir, $beg, $len) = $segment->Values([qw(IsLocatedIn(from-link)
1140                  'IsLocatedIn(dir)', 'IsLocatedIn(beg)', 'IsLocatedIn(len)']);                  IsLocatedIn(to-link) IsLocatedIn(dir) IsLocatedIn(beg) IsLocatedIn(len))]);
1141              # Determine if this feature actually overlaps the region. The query insures that              # Determine if this feature segment actually overlaps the region. The query insures that
1142              # this will be the case if the segment is the maximum length, so to fine-tune              # this will be the case if the segment is the maximum length, so to fine-tune
1143              # the results we insure that the inequality from the query holds using the actual              # the results we insure that the inequality from the query holds using the actual
1144              # length.              # length.
1145              my ($found, $end) = (0, 0);              my $loc = BasicLocation->new($contig, $beg, $dir, $len);
1146              if ($dir eq '+') {              my $found = $loc->Overlap($start, $stop);
                 $end = $beg + $len;  
                 if ($end >= $start) {  
                     # Denote we found a useful feature.  
                     $found = 1;  
                 }  
             } elsif ($dir eq '-') {  
                 # Note we switch things around so that the beginning is to the left of the  
                 # ending.  
                 ($beg, $end) = ($beg - $len, $beg);  
                 if ($beg <= $stop) {  
                     # Denote we found a useful feature.  
                     $found = 1;  
                 }  
             }  
1147              if ($found) {              if ($found) {
1148                  # Here we need to record the feature and update the minima and maxima. First,                  # Save this feature in the result list.
1149                  # get the current entry for the specified feature.                  $featuresFound{$featureID} = $segment;
                 my ($loc1, $loc2) = (exists $featuresFound{$featureID} ? @{$featuresFound{$featureID}} :  
                                      @initialMinMax);  
                 # Merge the current segment's begin and end into the feature begin and end and the  
                 # global min and max.  
                 if ($beg < $loc1) {  
                     $loc1 = $beg;  
                     $min = $beg if $beg < $min;  
                 }  
                 if ($end > $loc2) {  
                     $loc2 = $end;  
                     $max = $end if $end > $max;  
1150                  }                  }
                 # Store the entry back into the hash table.  
                 $featuresFound{$featureID} = [$loc1, $loc2];  
1151              }              }
1152          }          }
1153      }      # Return the ERDB objects for the features found.
1154      # Now we must compute the list of the IDs for the features found. We start with a list      return values %featuresFound;
     # of midpoints / feature ID pairs. (It's not really a midpoint, it's twice the midpoint,  
     # but the result of the sort will be the same.)  
     my @list = map { [$featuresFound{$_}->[0] + $featuresFound{$_}->[1], $_] } keys %featuresFound;  
     # Now we sort by midpoint and yank out the feature IDs.  
     my @retVal = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @list;  
     # Return it along with the min and max.  
     return (\@retVal, $min, $max);  
1155  }  }
1156    
1157  =head3 FType  =head3 FType
# Line 1585  Line 1594 
1594      my $genomeData = $self->GetEntity('Genome', $genomeID);      my $genomeData = $self->GetEntity('Genome', $genomeID);
1595      if ($genomeData) {      if ($genomeData) {
1596          # The genome exists, so get the completeness flag.          # The genome exists, so get the completeness flag.
1597          ($retVal) = $genomeData->Value('Genome(complete)');          $retVal = $genomeData->PrimaryValue('Genome(complete)');
1598      }      }
1599      # Return the result.      # Return the result.
1600      return $retVal;      return $retVal;
# Line 1616  Line 1625 
1625      # Get the parameters.      # Get the parameters.
1626      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
1627      # Get the desired feature's aliases      # Get the desired feature's aliases
1628      my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(alias)']);      my @retVal = $self->GetFlat(['IsAliasOf'], "IsAliasOf(to-link) = ?", [$featureID], 'IsAliasOf(from-link)');
1629      # Return the result.      # Return the result.
1630      return @retVal;      return @retVal;
1631  }  }
# Line 1645  Line 1654 
1654  sub GenomeOf {  sub GenomeOf {
1655      # Get the parameters.      # Get the parameters.
1656      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
     # Create a query to find the genome associated with the incoming ID.  
     my $query = $self->Get(['IsLocatedIn', 'HasContig'], "IsLocatedIn(from-link) = ? OR HasContig(to-link) = ?",  
                            [$featureID, $featureID]);  
1657      # Declare the return value.      # Declare the return value.
1658      my $retVal;      my $retVal;
1659      # Get the genome ID.      # Parse the genome ID from the feature ID.
1660      if (my $relationship = $query->Fetch()) {      if ($featureID =~ /^fig\|(\d+\.\d+)/) {
1661          ($retVal) = $relationship->Value('HasContig(from-link)');          $retVal = $1;
1662        } else {
1663            Confess("Invalid feature ID $featureID.");
1664      }      }
1665      # Return the value found.      # Return the value found.
1666      return $retVal;      return $retVal;
# Line 1682  Line 1690 
1690  sub CoupledFeatures {  sub CoupledFeatures {
1691      # Get the parameters.      # Get the parameters.
1692      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
1693        # Ask the coupling server for the data.
1694      Trace("Looking for features coupled to $featureID.") if T(coupling => 3);      Trace("Looking for features coupled to $featureID.") if T(coupling => 3);
1695      # Create a query to retrieve the functionally-coupled features.      my @rawPairs = FIGRules::NetCouplingData('coupled_to', id1 => $featureID);
1696      my $query = $self->Get(['ParticipatesInCoupling', 'Coupling'],      Trace(scalar(@rawPairs) . " couplings returned.") if T(coupling => 3);
1697                             "ParticipatesInCoupling(from-link) = ?", [$featureID]);      # Form them into a hash.
     # This value will be set to TRUE if we find at least one coupled feature.  
     my $found = 0;  
     # Create the return hash.  
1698      my %retVal = ();      my %retVal = ();
1699      # Retrieve the relationship records and store them in the hash.      for my $pair (@rawPairs) {
1700      while (my $clustering = $query->Fetch()) {          # Get the feature ID and score.
1701          # Get the ID and score of the coupling.          my ($featureID2, $score) = @{$pair};
1702          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',          # Only proceed if the feature is in NMPDR.
1703                                                          'Coupling(score)']);          if ($self->_CheckFeature($featureID2)) {
1704          Trace("$featureID coupled with score $score to ID $couplingID.") if T(coupling => 4);              $retVal{$featureID2} = $score;
1705          # Get the other feature that participates in the coupling.          }
         my ($otherFeatureID) = $self->GetFlat(['ParticipatesInCoupling'],  
                                            "ParticipatesInCoupling(to-link) = ? AND ParticipatesInCoupling(from-link) <> ?",  
                                            [$couplingID, $featureID], 'ParticipatesInCoupling(from-link)');  
         Trace("$couplingID target feature is $otherFeatureID.") if T(coupling => 4);  
         # Attach the other feature's score to its ID.  
         $retVal{$otherFeatureID} = $score;  
         $found = 1;  
1706      }      }
1707      # Functional coupling is reflexive. If we found at least one coupled feature, we must add      # Functional coupling is reflexive. If we found at least one coupled feature, we must add
1708      # the incoming feature as well.      # the incoming feature as well.
1709      if ($found) {      if (keys %retVal) {
1710          $retVal{$featureID} = 9999;          $retVal{$featureID} = 9999;
1711      }      }
1712      # Return the hash.      # Return the hash.
# Line 1764  Line 1763 
1763      my ($self, $peg1, $peg2) = @_;      my ($self, $peg1, $peg2) = @_;
1764      # Declare the return variable.      # Declare the return variable.
1765      my @retVal = ();      my @retVal = ();
1766      # Our first task is to find out the nature of the coupling: whether or not      # Get the coupling and evidence data.
1767      # it exists, its score, and whether the features are stored in the same      my @rawData = FIGRules::NetCouplingData('coupling_evidence', id1 => $peg1, id2 => $peg2);
1768      # order as the ones coming in.      # Loop through the raw data, saving the ones that are in NMPDR genomes.
1769      my ($couplingID, $inverted, $score) = $self->GetCoupling($peg1, $peg2);      for my $rawTuple (@rawData) {
1770      # Only proceed if a coupling exists.          if ($self->_CheckFeature($rawTuple->[0]) && $self->_CheckFeature($rawTuple->[1])) {
1771      if ($couplingID) {              push @retVal, $rawTuple;
         # Determine the ordering to place on the evidence items. If we're  
         # inverted, we want to see feature 2 before feature 1 (descending); otherwise,  
         # we want feature 1 before feature 2 (normal).  
         Trace("Coupling evidence for ($peg1, $peg2) with inversion flag $inverted.") if T(Coupling => 4);  
         my $ordering = ($inverted ? "DESC" : "");  
         # Get the coupling evidence.  
         my @evidenceList = $self->GetAll(['IsEvidencedBy', 'PCH', 'UsesAsEvidence'],  
                                           "IsEvidencedBy(from-link) = ? ORDER BY PCH(id), UsesAsEvidence(pos) $ordering",  
                                           [$couplingID],  
                                           ['PCH(used)', 'UsesAsEvidence(to-link)']);  
         # Loop through the evidence items. Each piece of evidence is represented by two  
         # positions in the evidence list, one for each feature on the other side of the  
         # evidence link. If at some point we want to generalize to couplings with  
         # more than two positions, this section of code will need to be re-done.  
         while (@evidenceList > 0) {  
             my $peg1Data = shift @evidenceList;  
             my $peg2Data = shift @evidenceList;  
             Trace("Peg 1 is " . $peg1Data->[1] . " and Peg 2 is " . $peg2Data->[1] . ".") if T(Coupling => 4);  
             push @retVal, [$peg1Data->[1], $peg2Data->[1], $peg1Data->[0]];  
1772          }          }
         Trace("Last index in evidence result is is $#retVal.") if T(Coupling => 4);  
1773      }      }
1774      # Return the result.      # Return the result.
1775      return @retVal;      return @retVal;
1776  }  }
1777    
 =head3 GetCoupling  
   
 C<< my ($couplingID, $inverted, $score) = $sprout->GetCoupling($peg1, $peg2); >>  
   
 Return the coupling (if any) for the specified pair of PEGs. If a coupling  
 exists, we return the coupling ID along with an indicator of whether the  
 coupling is stored as C<(>I<$peg1>C<, >I<$peg2>C<)> or C<(>I<$peg2>C<, >I<$peg1>C<)>.  
 In the second case, we say the coupling is I<inverted>. The importance of an  
 inverted coupling is that the PEGs in the evidence will appear in reverse order.  
   
 =over 4  
   
 =item peg1  
   
 ID of the feature of interest.  
   
 =item peg2  
   
 ID of the potentially coupled feature.  
   
 =item RETURN  
   
 Returns a three-element list. The first element contains the database ID of  
 the coupling. The second element is FALSE if the coupling is stored in the  
 database in the caller specified order and TRUE if it is stored in the  
 inverted order. The third element is the coupling's score. If the coupling  
 does not exist, all three list elements will be C<undef>.  
   
 =back  
   
 =cut  
 #: Return Type $%@;  
 sub GetCoupling {  
     # Get the parameters.  
     my ($self, $peg1, $peg2) = @_;  
     # Declare the return values. We'll start with the coupling ID and undefine the  
     # flag and score until we have more information.  
     my ($retVal, $inverted, $score) = ($self->CouplingID($peg1, $peg2), undef, undef);  
     # Find the coupling data.  
     my @pegs = $self->GetAll(['Coupling', 'ParticipatesInCoupling'],  
                                  "Coupling(id) = ? ORDER BY ParticipatesInCoupling(pos)",  
                                  [$retVal], ["ParticipatesInCoupling(from-link)", "Coupling(score)"]);  
     # Check to see if we found anything.  
     if (!@pegs) {  
         Trace("No coupling found.") if T(Coupling => 4);  
         # No coupling, so undefine the return value.  
         $retVal = undef;  
     } else {  
         # We have a coupling! Get the score and check for inversion.  
         $score = $pegs[0]->[1];  
         my $firstFound = $pegs[0]->[0];  
         $inverted = ($firstFound ne $peg1);  
         Trace("Coupling score is $score. First peg is $firstFound, peg 1 is $peg1.") if T(Coupling => 4);  
     }  
     # Return the result.  
     return ($retVal, $inverted, $score);  
 }  
   
1778  =head3 GetSynonymGroup  =head3 GetSynonymGroup
1779    
1780  C<< my $id = $sprout->GetSynonymGroup($fid); >>  C<< my $id = $sprout->GetSynonymGroup($fid); >>
# Line 1957  Line 1878 
1878      return ($contig, $beg, $end);      return ($contig, $beg, $end);
1879  }  }
1880    
 =head3 CouplingID  
   
 C<< my $couplingID = $sprout->CouplingID($peg1, $peg2); >>  
   
 Return the coupling ID for a pair of feature IDs.  
   
 The coupling ID is currently computed by joining the feature IDs in  
 sorted order with a space. Client modules (that is, modules which  
 use Sprout) should not, however, count on this always being the  
 case. This method provides a way for abstracting the concept of a  
 coupling ID. All that we know for sure about it is that it can be  
 generated easily from the feature IDs and the order of the IDs  
 in the parameter list does not matter (i.e. C<CouplingID("a1", "b1")>  
 will have the same value as C<CouplingID("b1", "a1")>.  
   
 =over 4  
   
 =item peg1  
   
 First feature of interest.  
   
 =item peg2  
   
 Second feature of interest.  
   
 =item RETURN  
   
 Returns the ID that would be used to represent a functional coupling of  
 the two specified PEGs.  
   
 =back  
   
 =cut  
 #: Return Type $;  
 sub CouplingID {  
     my ($self, @pegs) = @_;  
     return $self->DigestKey(join " ", sort @pegs);  
 }  
   
1881  =head3 ReadFasta  =head3 ReadFasta
1882    
1883  C<< my %sequenceData = Sprout::ReadFasta($fileName, $prefix); >>  C<< my %sequenceData = Sprout::ReadFasta($fileName, $prefix); >>
# Line 2346  Line 2228 
2228          push @retVal, $mappedAlias;          push @retVal, $mappedAlias;
2229      } else {      } else {
2230          # Here we have a non-FIG alias. Get the features with the normalized alias.          # Here we have a non-FIG alias. Get the features with the normalized alias.
2231          @retVal = $self->GetFlat(['Feature'], 'Feature(alias) = ?', [$mappedAlias], 'Feature(id)');          @retVal = $self->GetFlat(['IsAliasOf'], 'IsAliasOf(from-link) = ?', [$mappedAlias], 'IsAliasOf(to-link)');
2232      }      }
2233      # Return the result.      # Return the result.
2234      return @retVal;      return @retVal;
# Line 3383  Line 3265 
3265    
3266  =item fid  =item fid
3267    
3268  ID of the feature whose similarities are desired.  ID of the feature whose similarities are desired, or reference to a list of IDs
3269    of features whose similarities are desired.
3270    
3271  =item maxN  =item maxN
3272    
# Line 3920  Line 3803 
3803      return @retVal;      return @retVal;
3804  }  }
3805    
3806    =head3 _CheckFeature
3807    
3808    C<< my $flag = $sprout->_CheckFeature($fid); >>
3809    
3810    Return TRUE if the specified FID is probably an NMPDR feature ID, else FALSE.
3811    
3812    =over 4
3813    
3814    =item fid
3815    
3816    Feature ID to check.
3817    
3818    =item RETURN
3819    
3820    Returns TRUE if the FID is for one of the NMPDR genomes, else FALSE.
3821    
3822    =back
3823    
3824    =cut
3825    
3826    sub _CheckFeature {
3827        # Get the parameters.
3828        my ($self, $fid) = @_;
3829        # Insure we have a genome hash.
3830        if (! defined $self->{genomeHash}) {
3831            my %genomeHash = map { $_ => 1 } $self->GetFlat(['Genome'], "", [], 'Genome(id)');
3832            $self->{genomeHash} = \%genomeHash;
3833        }
3834        # Get the feature's genome ID.
3835        my ($genomeID) = FIGRules::ParseFeatureID($fid);
3836        # Return an indicator of whether or not the genome ID is in the hash.
3837        return ($self->{genomeHash}->{$genomeID} ? 1 : 0);
3838    }
3839    
3840  =head3 FriendlyTimestamp  =head3 FriendlyTimestamp
3841    
3842  Convert a time number to a user-friendly time stamp for display.  Convert a time number to a user-friendly time stamp for display.

Legend:
Removed from v.1.99  
changed lines
  Added in v.1.100

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3