[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.70, Fri Jun 23 19:08:58 2006 UTC
# Line 304  Line 304 
304      return ($arch, $bact, $euk, $vir, $env, $unk);      return ($arch, $bact, $euk, $vir, $env, $unk);
305  }  }
306    
307    =head3 ContigCount
308    
309    C<< my $count = $sprout->ContigCount($genomeID); >>
310    
311    Return the number of contigs for the specified genome ID.
312    
313    =over 4
314    
315    =item genomeID
316    
317    ID of the genome whose contig count is desired.
318    
319    =item RETURN
320    
321    Returns the number of contigs for the specified genome.
322    
323    =back
324    
325    =cut
326    
327    sub ContigCount {
328        # Get the parameters.
329        my ($self, $genomeID) = @_;
330        # Get the contig count.
331        my $retVal = $self->GetCount(['Contig', 'HasContig'], "HasContig(from-link) = ?", [$genomeID]);
332        # Return the result.
333        return $retVal;
334    }
335    
336    =head3 GeneMenu
337    
338    C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params); >>
339    
340    Return an HTML select menu of genomes. Each genome will be an option in the menu,
341    and will be displayed by name with the ID and a contig count attached. The selection
342    value will be the genome ID. The genomes will be sorted by genus/species name.
343    
344    =over 4
345    
346    =item attributes
347    
348    Reference to a hash mapping attributes to values for the SELECT tag generated.
349    
350    =item filterString
351    
352    A filter string for use in selecting the genomes. The filter string must conform
353    to the rules for the C<< ERDB->Get >> method.
354    
355    =item params
356    
357    Reference to a list of values to be substituted in for the parameter marks in
358    the filter string.
359    
360    =item RETURN
361    
362    Returns an HTML select menu with the specified genomes as selectable options.
363    
364    =back
365    
366    =cut
367    
368    sub GeneMenu {
369        # Get the parameters.
370        my ($self, $attributes, $filterString, $params) = @_;
371        # Start the menu.
372        my $retVal = "<select " .
373            join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .
374            ">\n";
375        # Get the genomes.
376        my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',
377                                                                         'Genome(genus)',
378                                                                         'Genome(species)',
379                                                                         'Genome(unique-characterization)']);
380        # Sort them by name.
381        my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;
382        # Loop through the genomes, creating the option tags.
383        for my $genomeData (@sorted) {
384            # Get the data for this genome.
385            my ($genomeID, $genus, $species, $strain) = @{$genomeData};
386            # Get the contig count.
387            my $count = $self->ContigCount($genomeID);
388            my $counting = ($count == 1 ? "contig" : "contigs");
389            # Build the option tag.
390            $retVal .= "<option value=\"$genomeID\">$genus $species $strain ($genomeID) [$count $counting]</option>\n";
391            Trace("Option tag built for $genomeID: $genus $species $strain.") if T(3);
392        }
393        # Close the SELECT tag.
394        $retVal .= "</select>\n";
395        # Return the result.
396        return $retVal;
397    }
398  =head3 Build  =head3 Build
399    
400  C<< $sprout->Build(); >>  C<< $sprout->Build(); >>
# Line 704  Line 795 
795      return @retVal;      return @retVal;
796  }  }
797    
798    =head3 GenomeLength
799    
800    C<< my $length = $sprout->GenomeLength($genomeID); >>
801    
802    Return the length of the specified genome in base pairs.
803    
804    =over 4
805    
806    =item genomeID
807    
808    ID of the genome whose base pair count is desired.
809    
810    =item RETURN
811    
812    Returns the number of base pairs in all the contigs of the specified
813    genome.
814    
815    =back
816    
817    =cut
818    
819    sub GenomeLength {
820        # Get the parameters.
821        my ($self, $genomeID) = @_;
822        # Declare the return variable.
823        my $retVal = 0;
824        # Get the genome's contig sequence lengths.
825        my @lens = $self->GetFlat(['HasContig', 'IsMadeUpOf'], 'HasContig(from-link) = ?',
826                           [$genomeID], 'IsMadeUpOf(len)');
827        # Sum the lengths.
828        map { $retVal += $_ } @lens;
829        # Return the result.
830        return $retVal;
831    }
832    
833    =head3 FeatureCount
834    
835    C<< my $count = $sprout->FeatureCount($genomeID, $type); >>
836    
837    Return the number of features of the specified type in the specified genome.
838    
839    =over 4
840    
841    =item genomeID
842    
843    ID of the genome whose feature count is desired.
844    
845    =item type
846    
847    Type of feature to count (eg. C<peg>, C<rna>, etc.).
848    
849    =item RETURN
850    
851    Returns the number of features of the specified type for the specified genome.
852    
853    =back
854    
855    =cut
856    
857    sub FeatureCount {
858        # Get the parameters.
859        my ($self, $genomeID, $type) = @_;
860        # Compute the count.
861        my $retVal = $self->GetCount(['HasFeature', 'Feature'],
862                                    "HasFeature(from-link) = ? AND Feature(feature-type) = ?",
863                                    [$genomeID, $type]);
864        # Return the result.
865        return $retVal;
866    }
867    
868    =head3 GenomeAssignments
869    
870    C<< my $fidHash = $sprout->GenomeAssignments($genomeID); >>
871    
872    Return a list of a genome's assigned features. The return hash will contain each
873    assigned feature of the genome mapped to the text of its most recent functional
874    assignment.
875    
876    =over 4
877    
878    =item genomeID
879    
880    ID of the genome whose functional assignments are desired.
881    
882    =item RETURN
883    
884    Returns a reference to a hash which maps each feature to its most recent
885    functional assignment.
886    
887    =back
888    
889    =cut
890    
891    sub GenomeAssignments {
892        # Get the parameters.
893        my ($self, $genomeID) = @_;
894        # Declare the return variable.
895        my $retVal = {};
896        # Query the genome's features and annotations. We'll put the oldest annotations
897        # first so that the last assignment to go into the hash will be the correct one.
898        my $query = $self->Get(['HasFeature', 'IsTargetOfAnnotation', 'Annotation'],
899                               "HasFeature(from-link) = ? ORDER BY Annotation(time)",
900                               [$genomeID]);
901        # Loop through the annotations.
902        while (my $data = $query->Fetch) {
903            # Get the feature ID and annotation text.
904            my ($fid, $annotation) = $data->Values(['HasFeature(to-link)',
905                                                    'Annotation(annotation)']);
906            # Check to see if this is an assignment. Note that the user really
907            # doesn't matter to us, other than we use it to determine whether or
908            # not this is an assignment.
909            my ($user, $assignment) = _ParseAssignment('fig', $annotation);
910            if ($user) {
911                # Here it's an assignment. We put it in the return hash, overwriting
912                # any older assignment that might be present.
913                $retVal->{$fid} = $assignment;
914            }
915        }
916        # Return the result.
917        return $retVal;
918    }
919    
920  =head3 ContigLength  =head3 ContigLength
921    
922  C<< my $length = $sprout->ContigLength($contigID); >>  C<< my $length = $sprout->ContigLength($contigID); >>
# Line 1454  Line 1667 
1667          # Get the ID and score of the coupling.          # Get the ID and score of the coupling.
1668          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',          my ($couplingID, $score) = $clustering->Values(['Coupling(id)',
1669                                                          'Coupling(score)']);                                                          'Coupling(score)']);
1670          # The coupling ID contains the two feature IDs separated by a space. We use          # Get the other feature that participates in the coupling.
1671          # this information to find the ID of the other feature.          my ($otherFeatureID) = $self->GetFlat(['ParticipatesInCoupling'],
1672          my ($fid1, $fid2) = split / /, $couplingID;                                             "ParticipatesInCoupling(to-link) = ? AND ParticipatesInCoupling(from-link) <> ?",
1673          my $otherFeatureID = ($featureID eq $fid1 ? $fid2 : $fid1);                                             [$couplingID, $featureID], 'ParticipatesInCoupling(from-link)');
1674          # Attach the other feature's score to its ID.          # Attach the other feature's score to its ID.
1675          $retVal{$otherFeatureID} = $score;          $retVal{$otherFeatureID} = $score;
1676          $found = 1;          $found = 1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3