[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.60, Wed Jun 14 19:47:19 2006 UTC revision 1.70, Fri Jun 23 19:08:58 2006 UTC
# Line 375  Line 375 
375      # Get the genomes.      # Get the genomes.
376      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',
377                                                                       'Genome(genus)',                                                                       'Genome(genus)',
378                                                                       'Genome(species)']);                                                                       'Genome(species)',
379                                                                         'Genome(unique-characterization)']);
380      # Sort them by name.      # Sort them by name.
381      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;
382      # Loop through the genomes, creating the option tags.      # Loop through the genomes, creating the option tags.
383      for my $genomeData (@sorted) {      for my $genomeData (@sorted) {
384          # Get the data for this genome.          # Get the data for this genome.
385          my ($genomeID, $genus, $species) = @{$genomeData};          my ($genomeID, $genus, $species, $strain) = @{$genomeData};
386          # Get the contig count.          # Get the contig count.
387          my $count = $self->ContigCount($genomeID);          my $count = $self->ContigCount($genomeID);
388          my $counting = ($count == 1 ? "contig" : "contigs");          my $counting = ($count == 1 ? "contig" : "contigs");
389          # Build the option tag.          # Build the option tag.
390          $retVal .= "<option value=\"$genomeID\">$genus $species ($genomeID) [$count $counting]</option>\n";          $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.      # Close the SELECT tag.
394      $retVal .= "</select>\n";      $retVal .= "</select>\n";
# Line 793  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 1546  Line 1670 
1670          # Get the other feature that participates in the coupling.          # Get the other feature that participates in the coupling.
1671          my ($otherFeatureID) = $self->GetFlat(['ParticipatesInCoupling'],          my ($otherFeatureID) = $self->GetFlat(['ParticipatesInCoupling'],
1672                                             "ParticipatesInCoupling(to-link) = ? AND ParticipatesInCoupling(from-link) <> ?",                                             "ParticipatesInCoupling(to-link) = ? AND ParticipatesInCoupling(from-link) <> ?",
1673                                             [$couplingID, $featureID], 'ParticipatesInCoupling(to-link)');                                             [$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.60  
changed lines
  Added in v.1.70

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3