[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.66, Sun Jun 18 07:33:53 2006 UTC revision 1.74, Sun Jun 25 07:34:46 2006 UTC
# Line 12  Line 12 
12      use DBObject;      use DBObject;
13      use Tracer;      use Tracer;
14      use FIGRules;      use FIGRules;
15        use FidCheck;
16      use Stats;      use Stats;
17      use POSIX qw(strftime);      use POSIX qw(strftime);
18    
# Line 375  Line 376 
376      # Get the genomes.      # Get the genomes.
377      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',
378                                                                       'Genome(genus)',                                                                       'Genome(genus)',
379                                                                       'Genome(species)']);                                                                       'Genome(species)',
380                                                                         'Genome(unique-characterization)']);
381      # Sort them by name.      # Sort them by name.
382      my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;      my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;
383      # Loop through the genomes, creating the option tags.      # Loop through the genomes, creating the option tags.
384      for my $genomeData (@sorted) {      for my $genomeData (@sorted) {
385          # Get the data for this genome.          # Get the data for this genome.
386          my ($genomeID, $genus, $species) = @{$genomeData};          my ($genomeID, $genus, $species, $strain) = @{$genomeData};
387          # Get the contig count.          # Get the contig count.
388          my $count = $self->ContigCount($genomeID);          my $count = $self->ContigCount($genomeID);
389          my $counting = ($count == 1 ? "contig" : "contigs");          my $counting = ($count == 1 ? "contig" : "contigs");
390          # Build the option tag.          # Build the option tag.
391          $retVal .= "<option value=\"$genomeID\">$genus $species ($genomeID) [$count $counting]</option>\n";          $retVal .= "<option value=\"$genomeID\">$genus $species $strain ($genomeID) [$count $counting]</option>\n";
392            Trace("Option tag built for $genomeID: $genus $species $strain.") if T(3);
393      }      }
394      # Close the SELECT tag.      # Close the SELECT tag.
395      $retVal .= "</select>\n";      $retVal .= "</select>\n";
# Line 836  Line 839 
839    
840  =over 4  =over 4
841    
842  =genomeID  =item genomeID
843    
844  ID of the genome whose feature count is desired.  ID of the genome whose feature count is desired.
845    
# Line 899  Line 902 
902      # Loop through the annotations.      # Loop through the annotations.
903      while (my $data = $query->Fetch) {      while (my $data = $query->Fetch) {
904          # Get the feature ID and annotation text.          # Get the feature ID and annotation text.
905          my ($fid, $annotation) = $data->Values(['HasFeature(from-link)',          my ($fid, $annotation) = $data->Values(['HasFeature(to-link)',
906                                                  'Annotation(annotation)']);                                                  'Annotation(annotation)']);
907          # Check to see if this is an assignment. Note that the user really          # Check to see if this is an assignment. Note that the user really
908          # doesn't matter to us, other than we use it to determine whether or          # doesn't matter to us, other than we use it to determine whether or
# Line 1801  Line 1804 
1804      my ($self, $peg1, $peg2) = @_;      my ($self, $peg1, $peg2) = @_;
1805      # Declare the return values. We'll start with the coupling ID and undefine the      # Declare the return values. We'll start with the coupling ID and undefine the
1806      # flag and score until we have more information.      # flag and score until we have more information.
1807      my ($retVal, $inverted, $score) = (CouplingID($peg1, $peg2), undef, undef);      my ($retVal, $inverted, $score) = ($self->CouplingID($peg1, $peg2), undef, undef);
1808      # Find the coupling data.      # Find the coupling data.
1809      my @pegs = $self->GetAll(['Coupling', 'ParticipatesInCoupling'],      my @pegs = $self->GetAll(['Coupling', 'ParticipatesInCoupling'],
1810                                   "Coupling(id) = ? ORDER BY ParticipatesInCoupling(pos)",                                   "Coupling(id) = ? ORDER BY ParticipatesInCoupling(pos)",
# Line 1822  Line 1825 
1825      return ($retVal, $inverted, $score);      return ($retVal, $inverted, $score);
1826  }  }
1827    
1828    =head3 GetSynonymGroup
1829    
1830    C<< my $id = $sprout->GetSynonymGroup($fid); >>
1831    
1832    Return the synonym group name for the specified feature.
1833    
1834    =over 4
1835    
1836    =item fid
1837    
1838    ID of the feature whose synonym group is desired.
1839    
1840    =item RETURN
1841    
1842    The name of the synonym group to which the feature belongs. If the feature does
1843    not belong to a synonym group, the feature ID itself is returned.
1844    
1845    =back
1846    
1847    =cut
1848    
1849    sub GetSynonymGroup {
1850        # Get the parameters.
1851        my ($self, $fid) = @_;
1852        # Declare the return variable.
1853        my $retVal;
1854        # Find the synonym group.
1855        my @groups = $self->GetFlat(['IsSynonymGroupFor'], "IsSynonymGroupFor(to-link) = ?",
1856                                       [$fid], 'IsSynonymGroupFor(from-link)');
1857        # Check to see if we found anything.
1858        if (@groups) {
1859            $retVal = $groups[0];
1860        } else {
1861            $retVal = $fid;
1862        }
1863        # Return the result.
1864        return $retVal;
1865    }
1866    
1867  =head3 CouplingID  =head3 CouplingID
1868    
1869  C<< my $couplingID = Sprout::CouplingID($peg1, $peg2); >>  C<< my $couplingID = $sprout->CouplingID($peg1, $peg2); >>
1870    
1871  Return the coupling ID for a pair of feature IDs.  Return the coupling ID for a pair of feature IDs.
1872    
# Line 1857  Line 1899 
1899  =cut  =cut
1900  #: Return Type $;  #: Return Type $;
1901  sub CouplingID {  sub CouplingID {
1902      return join " ", sort @_;      my ($self, @pegs) = @_;
1903        return $self->DigestKey(join " ", sort @pegs);
1904  }  }
1905    
1906  =head3 ReadFasta  =head3 ReadFasta
# Line 2216  Line 2259 
2259      return @retVal;      return @retVal;
2260  }  }
2261    
 =head3 Exists  
   
 C<< my $found = $sprout->Exists($entityName, $entityID); >>  
   
 Return TRUE if an entity exists, else FALSE.  
   
 =over 4  
   
 =item entityName  
   
 Name of the entity type (e.g. C<Feature>) relevant to the existence check.  
   
 =item entityID  
   
 ID of the entity instance whose existence is to be checked.  
   
 =item RETURN  
   
 Returns TRUE if the entity instance exists, else FALSE.  
   
 =back  
   
 =cut  
 #: Return Type $;  
 sub Exists {  
     # Get the parameters.  
     my ($self, $entityName, $entityID) = @_;  
     # Check for the entity instance.  
     Trace("Checking existence of $entityName with ID=$entityID.") if T(4);  
     my $testInstance = $self->GetEntity($entityName, $entityID);  
     # Return an existence indicator.  
     my $retVal = ($testInstance ? 1 : 0);  
     return $retVal;  
 }  
   
2262  =head3 FeatureTranslation  =head3 FeatureTranslation
2263    
2264  C<< my $translation = $sprout->FeatureTranslation($featureID); >>  C<< my $translation = $sprout->FeatureTranslation($featureID); >>
# Line 2788  Line 2796 
2796      return @retVal;      return @retVal;
2797  }  }
2798    
   
   
2799  =head3 RelatedFeatures  =head3 RelatedFeatures
2800    
2801  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>
# Line 3041  Line 3047 
3047      return %retVal;      return %retVal;
3048  }  }
3049    
3050    =head3 Sims
3051    
3052    C<< my $simList = $sprout->Sims($fid, $maxN, $maxP, $select, $max_expand, $filters); >>
3053    
3054    Get a list of similarities for a specified feature. Similarity information is not kept in the
3055    Sprout database; rather, they are retrieved from a network server. The similarities are
3056    returned as B<Sim> objects. A Sim object is actually a list reference that has been blessed
3057    so that its elements can be accessed by name.
3058    
3059    Similarities can be either raw or expanded. The raw similarities are basic
3060    hits between features with similar DNA. Expanding a raw similarity drags in any
3061    features considered substantially identical. So, for example, if features B<A1>,
3062    B<A2>, and B<A3> are all substatially identical to B<A>, then a raw similarity
3063    B<[C,A]> would be expanded to B<[C,A] [C,A1] [C,A2] [C,A3]>.
3064    
3065    =over 4
3066    
3067    =item fid
3068    
3069    ID of the feature whose similarities are desired.
3070    
3071    =item maxN
3072    
3073    Maximum number of similarities to return.
3074    
3075    =item maxP
3076    
3077    Minumum allowable similarity score.
3078    
3079    =item select
3080    
3081    Selection criterion: C<raw> means only raw similarities are returned; C<fig>
3082    means only similarities to FIG features are returned; C<all> means all expanded
3083    similarities are returned; and C<figx> means similarities are expanded until the
3084    number of FIG features equals the maximum.
3085    
3086    =item max_expand
3087    
3088    The maximum number of features to expand.
3089    
3090    =item filters
3091    
3092    Reference to a hash containing filter information, or a subroutine that can be
3093    used to filter the sims.
3094    
3095    =item RETURN
3096    
3097    Returns a reference to a list of similarity objects, or C<undef> if an error
3098    occurred.
3099    
3100    =back
3101    
3102    =cut
3103    
3104    sub Sims {
3105        # Get the parameters.
3106        my ($self, $fid, $maxN, $maxP, $select, $max_expand, $filters) = @_;
3107        # Create the shim object to test for deleted FIDs.
3108        my $shim = FidCheck->new($self);
3109        # Ask the network for sims.
3110        my $retVal = FIGRules::GetNetworkSims($shim, $fid, {}, $maxN, $maxP, $select, $max_expand, $filters);
3111        # Return the result.
3112        return $retVal;
3113    }
3114    
3115  =head3 GetGroups  =head3 GetGroups
3116    
3117  C<< my %groups = $sprout->GetGroups(\@groupList); >>  C<< my %groups = $sprout->GetGroups(\@groupList); >>

Legend:
Removed from v.1.66  
changed lines
  Added in v.1.74

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3