[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.58, Tue Jun 6 05:07:15 2006 UTC revision 1.73, Sun Jun 25 02:44:43 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 304  Line 305 
305      return ($arch, $bact, $euk, $vir, $env, $unk);      return ($arch, $bact, $euk, $vir, $env, $unk);
306  }  }
307    
308    =head3 ContigCount
309    
310    C<< my $count = $sprout->ContigCount($genomeID); >>
311    
312    Return the number of contigs for the specified genome ID.
313    
314    =over 4
315    
316    =item genomeID
317    
318    ID of the genome whose contig count is desired.
319    
320    =item RETURN
321    
322    Returns the number of contigs for the specified genome.
323    
324    =back
325    
326    =cut
327    
328    sub ContigCount {
329        # Get the parameters.
330        my ($self, $genomeID) = @_;
331        # Get the contig count.
332        my $retVal = $self->GetCount(['Contig', 'HasContig'], "HasContig(from-link) = ?", [$genomeID]);
333        # Return the result.
334        return $retVal;
335    }
336    
337    =head3 GeneMenu
338    
339    C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params); >>
340    
341    Return an HTML select menu of genomes. Each genome will be an option in the menu,
342    and will be displayed by name with the ID and a contig count attached. The selection
343    value will be the genome ID. The genomes will be sorted by genus/species name.
344    
345    =over 4
346    
347    =item attributes
348    
349    Reference to a hash mapping attributes to values for the SELECT tag generated.
350    
351    =item filterString
352    
353    A filter string for use in selecting the genomes. The filter string must conform
354    to the rules for the C<< ERDB->Get >> method.
355    
356    =item params
357    
358    Reference to a list of values to be substituted in for the parameter marks in
359    the filter string.
360    
361    =item RETURN
362    
363    Returns an HTML select menu with the specified genomes as selectable options.
364    
365    =back
366    
367    =cut
368    
369    sub GeneMenu {
370        # Get the parameters.
371        my ($self, $attributes, $filterString, $params) = @_;
372        # Start the menu.
373        my $retVal = "<select " .
374            join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .
375            ">\n";
376        # Get the genomes.
377        my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',
378                                                                         'Genome(genus)',
379                                                                         'Genome(species)',
380                                                                         'Genome(unique-characterization)']);
381        # Sort them by name.
382        my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;
383        # Loop through the genomes, creating the option tags.
384        for my $genomeData (@sorted) {
385            # Get the data for this genome.
386            my ($genomeID, $genus, $species, $strain) = @{$genomeData};
387            # Get the contig count.
388            my $count = $self->ContigCount($genomeID);
389            my $counting = ($count == 1 ? "contig" : "contigs");
390            # Build the option tag.
391            $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.
395        $retVal .= "</select>\n";
396        # Return the result.
397        return $retVal;
398    }
399  =head3 Build  =head3 Build
400    
401  C<< $sprout->Build(); >>  C<< $sprout->Build(); >>
# Line 704  Line 796 
796      return @retVal;      return @retVal;
797  }  }
798    
799    =head3 GenomeLength
800    
801    C<< my $length = $sprout->GenomeLength($genomeID); >>
802    
803    Return the length of the specified genome in base pairs.
804    
805    =over 4
806    
807    =item genomeID
808    
809    ID of the genome whose base pair count is desired.
810    
811    =item RETURN
812    
813    Returns the number of base pairs in all the contigs of the specified
814    genome.
815    
816    =back
817    
818    =cut
819    
820    sub GenomeLength {
821        # Get the parameters.
822        my ($self, $genomeID) = @_;
823        # Declare the return variable.
824        my $retVal = 0;
825        # Get the genome's contig sequence lengths.
826        my @lens = $self->GetFlat(['HasContig', 'IsMadeUpOf'], 'HasContig(from-link) = ?',
827                           [$genomeID], 'IsMadeUpOf(len)');
828        # Sum the lengths.
829        map { $retVal += $_ } @lens;
830        # Return the result.
831        return $retVal;
832    }
833    
834    =head3 FeatureCount
835    
836    C<< my $count = $sprout->FeatureCount($genomeID, $type); >>
837    
838    Return the number of features of the specified type in the specified genome.
839    
840    =over 4
841    
842    =item genomeID
843    
844    ID of the genome whose feature count is desired.
845    
846    =item type
847    
848    Type of feature to count (eg. C<peg>, C<rna>, etc.).
849    
850    =item RETURN
851    
852    Returns the number of features of the specified type for the specified genome.
853    
854    =back
855    
856    =cut
857    
858    sub FeatureCount {
859        # Get the parameters.
860        my ($self, $genomeID, $type) = @_;
861        # Compute the count.
862        my $retVal = $self->GetCount(['HasFeature', 'Feature'],
863                                    "HasFeature(from-link) = ? AND Feature(feature-type) = ?",
864                                    [$genomeID, $type]);
865        # Return the result.
866        return $retVal;
867    }
868    
869    =head3 GenomeAssignments
870    
871    C<< my $fidHash = $sprout->GenomeAssignments($genomeID); >>
872    
873    Return a list of a genome's assigned features. The return hash will contain each
874    assigned feature of the genome mapped to the text of its most recent functional
875    assignment.
876    
877    =over 4
878    
879    =item genomeID
880    
881    ID of the genome whose functional assignments are desired.
882    
883    =item RETURN
884    
885    Returns a reference to a hash which maps each feature to its most recent
886    functional assignment.
887    
888    =back
889    
890    =cut
891    
892    sub GenomeAssignments {
893        # Get the parameters.
894        my ($self, $genomeID) = @_;
895        # Declare the return variable.
896        my $retVal = {};
897        # Query the genome's features and annotations. We'll put the oldest annotations
898        # first so that the last assignment to go into the hash will be the correct one.
899        my $query = $self->Get(['HasFeature', 'IsTargetOfAnnotation', 'Annotation'],
900                               "HasFeature(from-link) = ? ORDER BY Annotation(time)",
901                               [$genomeID]);
902        # Loop through the annotations.
903        while (my $data = $query->Fetch) {
904            # Get the feature ID and annotation text.
905            my ($fid, $annotation) = $data->Values(['HasFeature(to-link)',
906                                                    'Annotation(annotation)']);
907            # 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
909            # not this is an assignment.
910            my ($user, $assignment) = _ParseAssignment('fig', $annotation);
911            if ($user) {
912                # Here it's an assignment. We put it in the return hash, overwriting
913                # any older assignment that might be present.
914                $retVal->{$fid} = $assignment;
915            }
916        }
917        # Return the result.
918        return $retVal;
919    }
920    
921  =head3 ContigLength  =head3 ContigLength
922    
923  C<< my $length = $sprout->ContigLength($contigID); >>  C<< my $length = $sprout->ContigLength($contigID); >>
# Line 1454  Line 1668 
1668          # Get the ID and score of the coupling.          # Get the ID and score of the coupling.
1669          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',
1670                                                          'Coupling(score)']);                                                          'Coupling(score)']);
1671          # The coupling ID contains the two feature IDs separated by a space. We use          # Get the other feature that participates in the coupling.
1672          # this information to find the ID of the other feature.          my ($otherFeatureID) = $self->GetFlat(['ParticipatesInCoupling'],
1673          my ($fid1, $fid2) = split / /, $couplingID;                                             "ParticipatesInCoupling(to-link) = ? AND ParticipatesInCoupling(from-link) <> ?",
1674          my $otherFeatureID = ($featureID eq $fid1 ? $fid2 : $fid1);                                             [$couplingID, $featureID], 'ParticipatesInCoupling(from-link)');
1675          # Attach the other feature's score to its ID.          # Attach the other feature's score to its ID.
1676          $retVal{$otherFeatureID} = $score;          $retVal{$otherFeatureID} = $score;
1677          $found = 1;          $found = 1;
# Line 1590  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 1613  Line 1827 
1827    
1828  =head3 CouplingID  =head3 CouplingID
1829    
1830  C<< my $couplingID = Sprout::CouplingID($peg1, $peg2); >>  C<< my $couplingID = $sprout->CouplingID($peg1, $peg2); >>
1831    
1832  Return the coupling ID for a pair of feature IDs.  Return the coupling ID for a pair of feature IDs.
1833    
# Line 1646  Line 1860 
1860  =cut  =cut
1861  #: Return Type $;  #: Return Type $;
1862  sub CouplingID {  sub CouplingID {
1863      return join " ", sort @_;      my ($self, @pegs) = @_;
1864        return $self->DigestKey(join " ", sort @pegs);
1865  }  }
1866    
1867  =head3 ReadFasta  =head3 ReadFasta
# Line 2005  Line 2220 
2220      return @retVal;      return @retVal;
2221  }  }
2222    
 =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;  
 }  
   
2223  =head3 FeatureTranslation  =head3 FeatureTranslation
2224    
2225  C<< my $translation = $sprout->FeatureTranslation($featureID); >>  C<< my $translation = $sprout->FeatureTranslation($featureID); >>
# Line 2577  Line 2757 
2757      return @retVal;      return @retVal;
2758  }  }
2759    
   
   
2760  =head3 RelatedFeatures  =head3 RelatedFeatures
2761    
2762  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>  C<< my @relatedList = $sprout->RelatedFeatures($featureID, $function, $userID); >>
# Line 2830  Line 3008 
3008      return %retVal;      return %retVal;
3009  }  }
3010    
3011    =head3 Sims
3012    
3013    C<< my $simList = $sprout->Sims($fid, $maxN, $maxP, $select, $max_expand, $filters); >>
3014    
3015    Get a list of similarities for a specified feature. Similarity information is not kept in the
3016    Sprout database; rather, they are retrieved from a network server. The similarities are
3017    returned as B<Sim> objects. A Sim object is actually a list reference that has been blessed
3018    so that its elements can be accessed by name.
3019    
3020    Similarities can be either raw or expanded. The raw similarities are basic
3021    hits between features with similar DNA. Expanding a raw similarity drags in any
3022    features considered substantially identical. So, for example, if features B<A1>,
3023    B<A2>, and B<A3> are all substatially identical to B<A>, then a raw similarity
3024    B<[C,A]> would be expanded to B<[C,A] [C,A1] [C,A2] [C,A3]>.
3025    
3026    =over 4
3027    
3028    =item fid
3029    
3030    ID of the feature whose similarities are desired.
3031    
3032    =item maxN
3033    
3034    Maximum number of similarities to return.
3035    
3036    =item maxP
3037    
3038    Minumum allowable similarity score.
3039    
3040    =item select
3041    
3042    Selection criterion: C<raw> means only raw similarities are returned; C<fig>
3043    means only similarities to FIG features are returned; C<all> means all expanded
3044    similarities are returned; and C<figx> means similarities are expanded until the
3045    number of FIG features equals the maximum.
3046    
3047    =item max_expand
3048    
3049    The maximum number of features to expand.
3050    
3051    =item filters
3052    
3053    Reference to a hash containing filter information, or a subroutine that can be
3054    used to filter the sims.
3055    
3056    =item RETURN
3057    
3058    Returns a reference to a list of similarity objects, or C<undef> if an error
3059    occurred.
3060    
3061    =back
3062    
3063    =cut
3064    
3065    sub Sims {
3066        # Get the parameters.
3067        my ($self, $fid, $maxN, $maxP, $select, $max_expand, $filters) = @_;
3068        # Create the shim object to test for deleted FIDs.
3069        my $shim = FidCheck->new($self);
3070        # Ask the network for sims.
3071        my $retVal = FIGRules::GetNetworkSims($shim, $fid, {}, $maxN, $maxP, $select, $max_expand, $filters);
3072        # Return the result.
3073        return $retVal;
3074    }
3075    
3076  =head3 GetGroups  =head3 GetGroups
3077    
3078  C<< my %groups = $sprout->GetGroups(\@groupList); >>  C<< my %groups = $sprout->GetGroups(\@groupList); >>

Legend:
Removed from v.1.58  
changed lines
  Added in v.1.73

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3