[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.107, Thu Feb 7 00:06:16 2008 UTC revision 1.108, Thu Feb 14 19:13:33 2008 UTC
# Line 150  Line 150 
150      return $retVal;      return $retVal;
151  }  }
152    
153  =head3 RealCoreGenomes  =head3 CoreGenomes
154    
155      my @genomes = $sprout->RealCoreGenomes();      my @genomes = $sprout->CoreGenomes($scope);
156    
157  Return the IDs of the original core NMPDR genomes. These are the ones  Return the IDs of NMPDR genomes in the specified scope.
158  in the major groups indicated in the C<$realCoreGroups> member of the  
159  B<FIG_Config> file.  =over 4
160    
161    =item scope
162    
163    Scope of the desired genomes. C<core> covers the original core genomes,
164    C<nmpdr> covers all genomes in NMPDR groups, and C<all> covers all
165    genomes in the system.
166    
167    =item RETURN
168    
169    Returns a list of the IDs for the genomes in the specified scope.
170    
171    =back
172    
173  =cut  =cut
174    
175  sub RealCoreGenomes {  sub CoreGenomes {
176      # Get the parameters.      # Get the parameters.
177      my ($self) = @_;      my ($self, $scope) = @_;
178      # Declare the return variable.      # Declare the return variable.
179      my @retVal = ();      my @retVal = ();
180      # Get the hash of all the genome groups.      # If we want all genomes, then this is easy.
181        if ($scope eq 'all') {
182            @retVal = $self->Genomes();
183        } else {
184            # Here we're dealing with groups. Get the hash of all the
185            # genome groups.
186      my %groups = $self->GetGroups();      my %groups = $self->GetGroups();
187      # Loop through the groups, keeping the ones that belong to real core          # Loop through the groups, keeping the ones that we want.
     # organisms.  
188      for my $group (keys %groups) {      for my $group (keys %groups) {
189                # Decide if we want to keep this group.
190                my $keepGroup = 0;
191                if ($scope eq 'nmpdr') {
192                    # NMPDR mode: keep all groups.
193                    $keepGroup = 1;
194                } elsif ($scope eq 'core') {
195                    # CORE mode. Only keep real core groups.
196          if (grep { $group =~ /$_/ } @{$FIG_Config::realCoreGroups}) {          if (grep { $group =~ /$_/ } @{$FIG_Config::realCoreGroups}) {
197                        $keepGroup = 1;
198                    }
199                }
200                # Add this group if we're keeping it.
201                if ($keepGroup) {
202              push @retVal, @{$groups{$group}};              push @retVal, @{$groups{$group}};
203          }          }
204      }      }
205        }
206      # Return the result.      # Return the result.
207      return @retVal;      return @retVal;
208  }  }
209    
210    =head3 SuperGroup
211    
212        my $superGroup = $sprout->SuperGroup($groupName);
213    
214    Return the name of the super-group containing the specified NMPDR genome
215    group. If no appropriate super-group can be found, an error will be
216    thrown.
217    
218    =over 4
219    
220    =item groupName
221    
222    Name of the group whose super-group is desired.
223    
224    =item RETURN
225    
226    Returns the name of the super-group containing the incoming group.
227    
228    =back
229    
230    =cut
231    
232    sub SuperGroup {
233        # Get the parameters.
234        my ($self, $groupName) = @_;
235        # Declare the return variable.
236        my $retVal;
237        # Get the group hash.
238        my %groupHash = $self->CheckGroupFile();
239        # Find the super-group genus.
240        $groupName =~ /([A-Z]\w+)/;
241        my $nameThing = $1;
242        # See if it's directly in the group hash.
243        if (exists $groupHash{$nameThing}) {
244            # Yes, then it's our result.
245            $retVal = $nameThing;
246        } else {
247            # No, so we have to search.
248            for my $superGroup (keys %groupHash) {
249                # Get this super-group's item list.
250                my $list = $groupHash{$superGroup}->{contents};
251                # Search it.
252                if (grep { $_->[0] eq $nameThing } @{$list}) {
253                    $retVal = $superGroup;
254                }
255            }
256            # Make sure we found something.
257            if (! $retVal) {
258                Confess("No super-group found for \"$groupName\".");
259            }
260        }
261        # Return the result.
262        return $retVal;
263    }
264    
265  =head3 MaxSegment  =head3 MaxSegment
266    
267      my $length = $sprout->MaxSegment();      my $length = $sprout->MaxSegment();
# Line 3649  Line 3733 
3733      my ($self, %groupHash) = @_;      my ($self, %groupHash) = @_;
3734      # Create the result hash.      # Create the result hash.
3735      my %retVal = ();      my %retVal = ();
     # Get the super-group table.  
     my %superTable = $self->CheckGroupFile();  
3736      # Copy over the genomes.      # Copy over the genomes.
3737      for my $groupID (keys %groupHash) {      for my $groupID (keys %groupHash) {
3738          # Get the super-group name.          # Get the super-group name.
3739          my $realGroupID;          my $realGroupID = $self->SuperGroup($groupID);
3740          if ($groupID =~ /([A-Z]\w+)/) {          # Append this group's genomes into the result hash
3741              if (! defined($superTable{$1})) {          # using the super-group name.
                 Confess("Super-group name not found for group $groupID.");  
             } else {  
                 $realGroupID = $1;  
             }  
         } else {  
             Confess("Invalid group name $groupID.");  
         }  
         # Append this group's genomes into the result hash.  
3742          push @{$retVal{$realGroupID}}, @{$groupHash{$groupID}};          push @{$retVal{$realGroupID}}, @{$groupHash{$groupID}};
3743      }      }
3744      # Return the result hash.      # Return the result hash.
# Line 3695  Line 3769 
3769  sub GroupPageName {  sub GroupPageName {
3770      # Get the parameters.      # Get the parameters.
3771      my ($self, $group) = @_;      my ($self, $group) = @_;
     # Declare the return variable.  
     my $retVal;  
3772      # Check for the group file data.      # Check for the group file data.
3773      my %superTable = $self->CheckGroupFile();      my %superTable = $self->CheckGroupFile();
3774      # Compute the real group name.      # Compute the real group name.
3775      if ($group =~ /([A-Z]\w+)/) {      my $realGroup = $self->SuperGroup($group);
3776          my $realGroup = $1;      # Get the associated page name.
3777          if (! defined($superTable{$1})) {      my $retVal = "../content/$superTable{$realGroup}->{page}";
             Confess("No super-group found for \"$group\".");  
         } else {  
             $retVal = "../content/$superTable{$1}->{page}";  
         }  
     } else {  
         Confess("\"group\" is not a valid group name.");  
     }  
3778      # Return the result.      # Return the result.
3779      return $retVal;      return $retVal;
3780  }  }

Legend:
Removed from v.1.107  
changed lines
  Added in v.1.108

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3