[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.105, Wed Jan 30 22:14:02 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 CoreGenomes
154    
155        my @genomes = $sprout->CoreGenomes($scope);
156    
157    Return the IDs of NMPDR genomes in the specified scope.
158    
159    =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
174    
175    sub CoreGenomes {
176        # Get the parameters.
177        my ($self, $scope) = @_;
178        # Declare the return variable.
179        my @retVal = ();
180        # 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();
187            # Loop through the groups, keeping the ones that we want.
188            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}) {
197                        $keepGroup = 1;
198                    }
199                }
200                # Add this group if we're keeping it.
201                if ($keepGroup) {
202                    push @retVal, @{$groups{$group}};
203                }
204            }
205        }
206        # Return the result.
207        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 3621  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 3667  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.105  
changed lines
  Added in v.1.108

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3