[Bio] / Sprout / SproutSubsys.pm Repository:
ViewVC logotype

Diff of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4, Mon Nov 28 22:52:11 2005 UTC revision 1.23, Thu Jun 4 18:21:58 2009 UTC
# Line 56  Line 56 
56    
57  List of [roleID, abbreviation] tuples in column order.  List of [roleID, abbreviation] tuples in column order.
58    
59    =item dir
60    
61    Directory root for the diagram and image files.
62    
63  =item reactionHash  =item reactionHash
64    
65  Map of role IDs to a list of the reactions catalyzed by the role.  Map of role IDs to a list of the reactions catalyzed by the role.
# Line 65  Line 69 
69  Map of PEG IDs to cluster numbers. This is used to create color maps for  Map of PEG IDs to cluster numbers. This is used to create color maps for
70  display of a subsystem's PEGs.  display of a subsystem's PEGs.
71    
72    =item hopeReactions
73    
74    Map of roles to EC numbers for the Hope reactions. This object is not loaded
75    until it is needed.
76    
77    =item rows
78    
79    Map of spreadsheet rows, keyed by genome ID. Each row is a list of cells. Each
80    cell is a list of feature ID.
81    
82    =item featureData
83    
84    Hash mapping feature IDs to assigned functions.
85    
86  =back  =back
87    
88  =cut  =cut
# Line 75  Line 93 
93    
94  =head3 new  =head3 new
95    
96  C<< my $sub = Subsystem->new($subName, $sprout); >>      my $sub = SproutSubsys->new($subName, $sprout);
97    
98  Load the subsystem.  Load the subsystem.
99    
# Line 102  Line 120 
120      }      }
121      # Declare the return value.      # Declare the return value.
122      my $retVal;      my $retVal;
123      # Get the subsystem's data fields.      # Get the subsystem's object.
124      my ($curator, $notes) = $sprout->GetEntityValues('Subsystem', $subName, ['Subsystem(curator)',      my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
125                                                                               'Subsystem(notes)']);      if (! defined $subsystemObject) {
126      # Only proceed if we found the subsystem.          # Here we're stuck.
127      if (defined $curator) {          Confess("Subsystem \"$subName\" not found in database.");
128        } else {
129            # We've found it, so get the major data.
130            my ($curator, $notes, $description, $version) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
131                                                                'Subsystem(description)', 'Subsystem(version)']);
132          # Get the genome IDs and variant codes for the rows. The list returned          # Get the genome IDs and variant codes for the rows. The list returned
133          # by GetAll will be a list of 2-tuples, each consisting of a genome ID          # by GetAll will be a list of 2-tuples, each consisting of a genome ID
134          # and a subsystem variant code.          # and a subsystem variant code.
# Line 121  Line 143 
143          # Get the role IDs and abbreviations. The list returned by GetAll will be          # Get the role IDs and abbreviations. The list returned by GetAll will be
144          # a list of 2-tuples, each consisting of a role ID and abbreviation. The          # a list of 2-tuples, each consisting of a role ID and abbreviation. The
145          # 2-tuples will be ordered by the spreadsheet column number.          # 2-tuples will be ordered by the spreadsheet column number.
146          my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],          my @roles = $sprout->GetAll(['OccursInSubsystem'],
147                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
148                                      [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);                                      [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)',
149          # Now we need to create the role ID directory and the reaction hash.                                                   'OccursInSubsystem(auxiliary)']);
150          # The role ID directory maps role IDs and their abbreviations to column numbers.          # Now we need to create the role ID directory, which maps role IDs and their
151          # The reaction hash maps a role ID to a list of the IDs for the reactions it          # abbreviations to column numbers.
         # catalyzes.  
152          my %roleHash = ();          my %roleHash = ();
153          my %reactionHash = ();          my %abbrHash = ();
154            my %auxHash = ();
155          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
156              # Get the role ID and abbreviation for this column's role.              # Get the role ID, aux flag, and abbreviation for this column's role.
157              my ($roleID, $abbr) = @{$roles[$idx]};              my ($roleID, $abbr, $aux) = @{$roles[$idx]};
158              # Put them both in the role directory.              # Put the ID and abbreviation in the role directory.
159              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
160              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
161              # Get this role's reactions.              # Put the aux flag in the aux hash.
162              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              $auxHash{$roleID} = $aux;
163                                               [$roleID], 'Catalyzes(to-link)');              # Put the full name in the abbreviation directory.
164              # Put them in the reaction hash.              $abbrHash{$abbr} = $roleID;
             if (@reactions > 0) {  
                 $reactionHash{$roleID} = \@reactions;  
             }  
165          }          }
166            # Find the subsystem directory.
167            my $subDir = Subsystem::get_dir_from_name($subName);
168            Trace("Subsystem directory is $subDir.") if T(3);
169          # Create the subsystem object.          # Create the subsystem object.
170          $retVal = {          $retVal = {
171                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
172                      # accesses required.                      # accesses required.
173                      name => $subName,                      name => $subName,
174                        # Directory root for diagram and image files.
175                        dir => $subDir,
176                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
177                      curator => $curator,                      curator => $curator,
178                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 165  Line 189 
189                      roles => \@roles,                      roles => \@roles,
190                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
191                      colorHash => {},                      colorHash => {},
192                        # Map of abbreviations to role names.
193                        abbrHash => \%abbrHash,
194                        # Map of auxiliary rols.
195                        auxHash => \%auxHash,
196                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
197                      reactionHash => \%reactionHash,                      reactionHash => undef,
198                        # Version number.
199                        version => $version,
200                        # Row hash, initially undefined.
201                        rows => undef,
202                        # Map of feature IDs to functional assignments
203                        featureData => {},
204                  };                  };
205          # Bless and return it.          # Bless and return it.
206          bless $retVal, $class;          bless $retVal, $class;
# Line 174  Line 208 
208      return $retVal;      return $retVal;
209  }  }
210    
211    =head3 is_aux_role
212    
213        my $flag = $sub->is_aux_role($roleID);
214    
215    Return TRUE if the specified role is auxiliary to this subsystem, FALSE
216    if it is essential to it.
217    
218    =over 4
219    
220    =item roleID
221    
222    ID of the relevant role.
223    
224    =item RETURN
225    
226    Returns TRUE if the specified role is auxiliary, else FALSE.
227    
228    =back
229    
230    =cut
231    
232    sub is_aux_role {
233        # Get the parameters.
234        my ($self, $roleID) = @_;
235        # Declare the return variable.
236        my $retVal = $self->{auxHash}->{$roleID};
237        # Return the result.
238        return $retVal;
239    }
240    
241    
242    =head3 get_row
243    
244        my $rowData = $sub->get_row($rowIndex);
245    
246    Return the specified row in the subsystem spreadsheet. The row consists
247    of a list of lists. Each position in the major list represents the role
248    for that position, and contains a list of the IDs for the features that
249    perform the role.
250    
251    =over 4
252    
253    =item rowIndex
254    
255    Index of the row to return. A row contains data for a single genome.
256    
257    =item RETURN
258    
259    Returns a reference to a list of lists. Each element in the list represents
260    a spreadsheet column (role) and contains a list of features that perform the
261    role.
262    
263    =back
264    
265    =cut
266    
267    sub get_row {
268        # Get the parameters.
269        my ($self, $rowIndex) = @_;
270        # Get the genome ID for the specified row's genome.
271        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
272        # Get the row hash.
273        my $rowHash = $self->_get_spreadsheet();
274        # Declare the return variable.
275        my @retVal;
276        # If this genome does not exist for the subsystem, all the cells are empty.
277        if (! exists $rowHash->{$genomeID}) {
278            @retVal = map { [] } @{$self->{roles}};
279        } else {
280            # Here we just return the row.
281            push @retVal, @{$rowHash->{$genomeID}};
282        }
283        # Return the result.
284        return \@retVal;
285    }
286    
287    =head3 get_roles_for_genome
288    
289        my @roles = $sub->get_roles_for_genome($genome_id);
290    
291    Return a list of the roles in this subsystem that have nonempty
292    spreadsheet cells for the given genome.
293    
294    =over 4
295    
296    =item genome_id
297    
298    ID of the relevant genome.
299    
300    =item RETURN
301    
302    Returns a list of role IDs.
303    
304    =back
305    
306    =cut
307    
308    sub get_roles_for_genome {
309        # Get the parameters.
310        my ($self, $genome_id) = @_;
311        # Get the subsystem's spreadsheet.
312        my $rowHash = $self->_get_spreadsheet();
313        # Declare the return variable.
314        my @retVal;
315        # Only proceed if this genome exists for this subsyste,
316        if (exists $rowHash->{$genome_id}) {
317            # Get the role list.
318            my $roles = $self->{roles};
319            # Get the row's cell list.
320            my $row = $rowHash->{$genome_id};
321            # Loop through the cells. We'll save the role name for each
322            # nonempty cell.
323            my $cols = scalar @$roles;
324            for (my $i = 0; $i < $cols; $i++) {
325                my $cell = $row->[$i];
326                if (scalar @$cell) {
327                    push @retVal, $roles->[$i][0];
328                }
329            }
330        }
331        # Return the result.
332        return @retVal;
333    }
334    
335    =head3 get_abbr_for_role
336    
337        my $abbr = $sub->get_abbr_for_role($name);
338    
339    Get this subsystem's abbreviation for the specified role.
340    
341    =over 4
342    
343    =item name
344    
345    Name of the relevant role.
346    
347    =item RETURN
348    
349    Returns the abbreviation for the role. Each subsystem has its own abbreviation
350    system; the abbreviations make it easier to display the subsystem spreadsheet.
351    
352    =back
353    
354    =cut
355    
356    sub get_abbr_for_role {
357        # Get the parameters.
358        my ($self, $name) = @_;
359        # Get the index for this role.
360        my $idx = $self->get_role_index($name);
361        # Return the abbreviation.
362        return $self->get_role_abbr($idx);
363    }
364    
365    =head3 get_subsetC
366    
367        my @columns = $sub->get_subsetC($subsetName);
368    
369    Return a list of the column numbers for the columns in the named role
370    subset.
371    
372    =over 4
373    
374    =item subsetName
375    
376    Name of the subset whose columns are desired.
377    
378    =item RETURN
379    
380    Returns a list of the indices for the columns in the named subset.
381    
382    =back
383    
384    =cut
385    
386    sub get_subsetC {
387        # Get the parameters.
388        my ($self, $subsetName) = @_;
389        # Get the roles in the subset.
390        my @roles = $self->get_subsetC_roles($subsetName);
391        # Convert them to indices.
392        my $roleHash = $self->{roleHash};
393        my @retVal = map { $roleHash->{$_} } @roles;
394        # Return the result.
395        return @retVal;
396    }
397    
398  =head3 get_genomes  =head3 get_genomes
399    
400  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
401    
402  Return a list of the genome IDs for this subsystem. Each genome corresponds to a row  Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
403  in the subsystem spreadsheet. Indexing into this list returns the ID of the genome  in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
# Line 196  Line 417 
417    
418  =head3 get_variant_code  =head3 get_variant_code
419    
420  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
421    
422  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
423  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 222  Line 443 
443      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
444      # Extract the variant code for the specified row index. It is the second      # Extract the variant code for the specified row index. It is the second
445      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
446      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
447      return $retVal;      return $retVal;
448  }  }
449    
450  =head3 get_curator  =head3 get_curator
451    
452  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
453    
454  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
455    
# Line 243  Line 464 
464    
465  =head3 get_notes  =head3 get_notes
466    
467  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
468    
469  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
470    
# Line 256  Line 477 
477      return $self->{notes};      return $self->{notes};
478  }  }
479    
480    =head3 get_description
481    
482        my $text = $sub->get_description();
483    
484    Return the description for this subsystem.
485    
486    =cut
487    
488    sub get_description
489    {
490        my($self) = @_;
491        return $self->{description};
492    }
493    
494  =head3 get_roles  =head3 get_roles
495    
496  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
497    
498  Return a list of the subsystem's roles. Each role corresponds to a column  Return a list of the subsystem's roles. Each role corresponds to a column
499  in the subsystem spreadsheet. The list entry at a specified position in  in the subsystem spreadsheet. The list entry at a specified position in
# Line 277  Line 512 
512    
513  =head3 get_reactions  =head3 get_reactions
514    
515  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
516    
517  Return a reference to a hash that maps each role ID to a list of the reactions  Return a reference to a hash that maps each role ID to a list of the reactions
518  catalyzed by the role.  catalyzed by the role.
# Line 287  Line 522 
522  sub get_reactions {  sub get_reactions {
523      # Get the parameters.      # Get the parameters.
524      my ($self) = @_;      my ($self) = @_;
525      # Return the reaction hash member.      # Do we already have a reaction hash?
526      return $self->{reactionHash};      my $retVal = $self->{reactionHash};
527        if (! $retVal) {
528            # No, so we'll build it.
529            $retVal = {};
530            my $sprout = $self->{sprout};
531            for my $roleID ($self->get_roles()) {
532                # Get this role's reactions.
533                my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
534                                                 [$roleID], 'Catalyzes(to-link)');
535                # Put them in the reaction hash.
536                if (@reactions > 0) {
537                    $retVal->{$roleID} = \@reactions;
538                }
539            }
540            # Save it for future use.
541            $self->{reactionHash} = $retVal;
542        }
543        # Return the reaction hash.
544        return $retVal;
545  }  }
546    
547  =head3 get_subset_namesC  =head3 get_subset_namesC
548    
549  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
550    
551  Return a list of the names for all the column (role) subsets. Given a subset  Return a list of the names for all the column (role) subsets. Given a subset
552  name, you can use the L</get_subsetC_roles> method to get the roles in the  name, you can use the L</get_subsetC_roles> method to get the roles in the
# Line 315  Line 568 
568      return @retVal;      return @retVal;
569  }  }
570    
571    =head3 get_subset_names
572    
573        my @subsetNames = $sub->get_subset_names();
574    
575    Return the names of the column subsets.
576    
577    =cut
578    
579    sub get_subset_names{
580        # Get the parameters.
581        my ($self) = @_;
582        # Return the result.
583        return $self->get_subset_namesC();
584    }
585    
586  =head3 get_role_abbr  =head3 get_role_abbr
587    
588  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
589    
590  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
591  is a shortened identifier that is not necessarily unique, but is more likely to  is a shortened identifier that is not necessarily unique, but is more likely to
# Line 346  Line 614 
614      return $retVal;      return $retVal;
615  }  }
616    
617    
618    =head3 get_hope_reactions_for_genome
619    
620        my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
621    
622    This method returns a hash that maps reactions to the pegs that catalyze
623    them for the specified genome. For each role in the subsystem, the pegs
624    are computed, and these are attached to the reactions for the role.
625    
626    =over 4
627    
628    =item genome
629    
630    ID of the genome whose reactions are to be put into the hash.
631    
632    =item RETURN
633    
634    Returns a hash mapping reactions in the subsystem to pegs in the
635    specified genome, or an empty hash if the genome is not found in the
636    subsystem.
637    
638    =back
639    
640    =cut
641    
642    sub get_hope_reactions_for_genome {
643        # Get the parameters.
644        my($self, $genome) = @_;
645        # Declare the return variable.
646        my %retVal;
647        # Look for the genome in our spreadsheet.
648        my $index = $self->get_genome_index($genome);
649        # Only proceed if we found it.
650        if (defined $index) {
651            # Extract the roles.
652            my @roles = $self->get_roles;
653            # Get the hope reaction hash. For each role, this gives us a list
654            # of reactions.
655            my %hope_reactions = $self->get_hope_reactions();
656            # Loop through the cells in this genome's role.
657            for my $role (@roles) {
658                # Get the features in this role's cell.
659                my @peg_list = $self->get_pegs_from_cell($genome,$role);
660                # Only proceed if we have hope reactions AND pegs for this role.
661                if (defined $hope_reactions{$role} && scalar @peg_list > 0) {
662                    # Loop through the reactions, pushing the pegs in this cell onto
663                    # the reaction's peg list.
664                    for my $reaction (@{$hope_reactions{$role}}) {
665                        push @{$retVal{$reaction}}, @peg_list;
666                    }
667                }
668            }
669        }
670        # Return the result.
671        return %retVal;
672    }
673    
674    
675    =head3 get_hope_additional_reactions
676    
677        my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
678    
679    Return a list of the additional reactions for the specified scenario.
680    
681    =over 4
682    
683    =item scenario_name
684    
685    Name of the scenario whose additional reactions are desired.
686    
687    =item RETURN
688    
689    Returns a list of the additional reactions attached to the named scenario.
690    
691    =back
692    
693    =cut
694    
695    sub get_hope_additional_reactions {
696        # Get the parameters.
697        my($self, $scenario_name) = @_;
698        # Ask the database for this scenario's additional reactions.
699        my @retVal = $self->{sprout}->GetFlat(['IncludesReaction'], "IncludesReaction(from-link) = ?",
700                                              [$scenario_name], 'IncludesReaction(to-link)');
701        return @retVal;
702    }
703    
704    
705    =head3 get_hope_reactions
706    
707        my %reactionHash = $subsys->get_hope_reactions();
708    
709    Return a hash mapping the roles of this subsystem to the EC numbers for
710    the reactions used in scenarios (if any). It may return an empty hash
711    if the Hope reactions are not yet known.
712    
713    =cut
714    
715    sub get_hope_reactions {
716        # Get the parameters.
717        my ($self) = @_;
718        # Try to get the hope reactions from the object.
719        my $retVal = $self->{hopeReactions};
720        if (! defined($retVal)) {
721            # They do not exist, so we must create them. Make a copy of the role-to-reaction
722            # hash.
723            my %hopeHash = %{$self->get_reactions()};
724            # Insure we have it if we need it again.
725            $retVal = \%hopeHash;
726            $self->{hopeReactions} = $retVal;
727        }
728        # Return the result.
729        return %{$retVal};
730    }
731    
732    =head3 get_hope_reaction_notes
733    
734        my %roleHash = $sub->get_hope_reaction_notes();
735    
736    Return a hash mapping the roles of the subsystem to any existing notes
737    about the relevant reactions.
738    
739    =cut
740    
741    sub get_hope_reaction_notes {
742        # Get the parameters.
743        my ($self) = @_;
744        # Declare the return variable.
745        my %retVal;
746        # Get the database object.
747        my $sprout = $self->{sprout};
748        # Get our name.
749        my $ssName = $self->{name};
750        # Loop through the roles, getting each role's hope notes.
751        for my $role ($self->get_roles()) {
752            my ($note) = $self->get_hope_reaction_note($role);
753            # If this role had a nonempty note, stuff it in the hash.
754            if ($note) {
755                $retVal{$role} = $note;
756            }
757        }
758        # Return the result.
759        return %retVal;
760    }
761    
762    =head3 get_hope_reaction_note
763    
764        my $note = $sub->get_hope_reaction_note($role);
765    
766    Return the text note about the curation of the scenario reactions
767    relating to this role.
768    
769    =over 4
770    
771    =item role
772    
773    ID of the role whose note is desired.
774    
775    =item RETURN
776    
777    Returns the relevant role's note for this subsystem's hope reactions, or FALSE (empty string
778    or undefined) if no such note was found.
779    
780    =back
781    
782    =cut
783    
784    sub get_hope_reaction_note {
785        # Get the parameters.
786        my ($self, $role) = @_;
787        # Ask the database for the note.
788        my ($retVal) = $self->{sprout}->GetFlat(['OccursInSubsystem'],
789                                                "OccursInSubsystem(from-link) = ? AND OccursInSubsystem(to-link) = ?",
790                                                [$role, $self->{name}], 'OccursInSubsystem(hope-reaction-note)');
791        # Return the result.
792        return $retVal;
793    }
794    
795  =head3 get_role_index  =head3 get_role_index
796    
797  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
798    
799  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
800    
# Line 376  Line 822 
822    
823  =head3 get_subsetC_roles  =head3 get_subsetC_roles
824    
825  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
826    
827  Return the names of the roles contained in the specified role (column) subset.  Return the names of the roles contained in the specified role (column) subset.
828    
# Line 414  Line 860 
860    
861  =head3 get_genome_index  =head3 get_genome_index
862    
863  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
864    
865  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
866    
# Line 443  Line 889 
889    
890  =head3 get_cluster_number  =head3 get_cluster_number
891    
892  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
893    
894  Return the cluster number for the specified PEG, or C<-1> if the  Return the cluster number for the specified PEG, or C<-1> if the
895  cluster number for the PEG is unknown or it is not clustered.  cluster number for the PEG is unknown or it is not clustered.
896    
 The cluster number is read into the color hash by the  
 L</get_pegs_from_cell> method. If the incoming PEG IDs do not  
 come from the most recent cell retrievals, the information returned  
 will be invalid. This is a serious design flaw which needs to be  
 fixed soon.  
   
897  =over 4  =over 4
898    
899  =item pegID  =item pegID
# Line 473  Line 913 
913      my ($self, $pegID) = @_;      my ($self, $pegID) = @_;
914      # Declare the return variable.      # Declare the return variable.
915      my $retVal = -1;      my $retVal = -1;
916        # Insure we have a color hash.
917        $self->_get_spreadsheet();
918      # Check for a cluster number in the color hash.      # Check for a cluster number in the color hash.
919      if (exists $self->{colorHash}->{$pegID}) {      if (exists $self->{colorHash}->{$pegID}) {
920          $retVal = $self->{colorHash}->{$pegID};          $retVal = $self->{colorHash}->{$pegID};
# Line 481  Line 923 
923      return $retVal;      return $retVal;
924  }  }
925    
926    
927  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
928    
929  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
930    
931  Return a list of the peg IDs for the features in the specified spreadsheet cell.  Return a list of the peg IDs for the features in the specified spreadsheet cell.
932    
# Line 532  Line 975 
975              $genomeID = $genomeList->[$rowstr]->[0];              $genomeID = $genomeList->[$rowstr]->[0];
976          }          }
977      }      }
978      # Construct the spreadsheet cell ID from the information we have.      # Get the spreadsheet.
979      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $rowHash = $self->_get_spreadsheet();
980      # Get the list of PEG IDs and cluster numbers for the indicated cell.      # Delcare the return variable.
981      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @retVal;
982                                    [$cellID], ['ContainsFeature(to-link)',      # Only proceed if this genome is in this subsystem.
983                                                'ContainsFeature(cluster-number)']);      if (exists $rowHash->{$genomeID}) {
984      # Copy the pegs into the return list, and save the cluster numbers in the color hash.          # Push the cell's contents into the return list.
985      my @retVal = ();          push @retVal, @{$rowHash->{$genomeID}->[$colIdx]};
     for my $pegEntry (@pegList) {  
         my ($peg, $cluster) = @{$pegEntry};  
         $self->{colorHash}->{$peg} = $cluster;  
         push @retVal, $peg;  
986      }      }
987      # Return the list. If the spreadsheet cell was empty or non-existent, we'll end      # Return the list. If the spreadsheet cell was empty or non-existent, we'll end
988      # up returning an empty list.      # up returning an empty list.
989      return @retVal;      return @retVal;
990  }  }
991    
992    =head3 get_subsetR
993    
994        my @genomes = $sub->get_subsetR($subName);
995    
996    Return the genomes in the row subset indicated by the specified subset name.
997    
998    =over 4
999    
1000    =item subName
1001    
1002    Name of the desired row subset, or C<All> to get all of the rows.
1003    
1004    =item RETURN
1005    
1006    Returns a list of genome IDs corresponding to the named subset.
1007    
1008    =back
1009    
1010    =cut
1011    
1012    sub get_subsetR {
1013        # Get the parameters.
1014        my ($self, $subName) = @_;
1015        # Look for the specified row subset in the database. A row subset is identified using
1016        # the subsystem name and the subset name. The special subset "All" is actually
1017        # represented in the database, so we don't need to check for it.
1018        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
1019                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
1020        return @rows;
1021    }
1022    
1023  =head3 get_diagrams  =head3 get_diagrams
1024    
1025  C<< my @list = $sub->get_diagrams(); >>      my @list = $sub->get_diagrams();
1026    
1027  Return a list of the diagrams associated with this subsystem. Each diagram  Return a list of the diagrams associated with this subsystem. Each diagram
1028  is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,  is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
# Line 588  Line 1058 
1058  sub get_diagrams {  sub get_diagrams {
1059      # Get the parameters.      # Get the parameters.
1060      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
1061      # Get the diagram IDs.      # Get the diagram IDs.
1062      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
1063        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
1064      # Create the return variable.      # Create the return variable.
1065      my @retVal = ();      my @retVal = ();
1066      # Loop through the diagram IDs.      # Loop through the diagram IDs.
1067      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
1068          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
1069          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
1070          # If a name was found, get the URLs.          Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
         if ($name) {  
             my ($link, $imgLink) = Subsystem::ComputeDiagramURLs($self->{name},  
                                                                  $diagramID);  
1071              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
1072          }          }
1073        # Return the result.
1074        return @retVal;
1075    }
1076    
1077    =head3 get_diagram
1078    
1079        my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
1080    
1081    Get the information (if any) for the specified diagram. The diagram corresponds
1082    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1083    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1084    where I<$dir> is the subsystem directory. The diagram's name is extracted from
1085    a tiny file containing the name, and then the links are computed using the
1086    subsystem name and the diagram ID. The parameters are as follows.
1087    
1088    =over 4
1089    
1090    =item id
1091    
1092    ID code for the desired diagram.
1093    
1094    =item RETURN
1095    
1096    Returns a three-element list. The first element is the diagram name, the second
1097    a URL for displaying information about the diagram, and the third a URL for
1098    displaying the diagram image.
1099    
1100    =back
1101    
1102    =cut
1103    
1104    sub get_diagram {
1105        my($self, $id) = @_;
1106        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
1107        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
1108        return($name, $link, $img_link);
1109    }
1110    
1111    
1112    =head3 get_diagram_html_file
1113    
1114        my $fileName = $sub->get_diagram_html_file($id);
1115    
1116    Get the HTML file (if any) for the specified diagram. The diagram corresponds
1117    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1118    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1119    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1120    named C<diagram.html> in the diagram directory.  The parameters are as follows.
1121    
1122    =over 4
1123    
1124    =item id
1125    
1126    ID code for the desired diagram.
1127    
1128    =item RETURN
1129    
1130    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1131    
1132    =back
1133    
1134    =cut
1135    
1136    sub get_diagram_html_file {
1137        my ($self, $id) = @_;
1138        my $retVal;
1139        my $ddir = "$self->{dir}/diagrams/$id";
1140        Trace("Looking for diagram file at $ddir.") if T(3);
1141        if (-d $ddir) {
1142            my $html = "$ddir/diagram.html";
1143            if (-f $html) {
1144                $retVal = $html;
1145            }
1146        }
1147        return $retVal;
1148    }
1149    
1150    =head3 is_new_diagram
1151    
1152        my $flag = $sub->is_new_diagram($id);
1153    
1154    Return TRUE if the specified diagram is in the new format, else FALSE.
1155    
1156    =over 4
1157    
1158    =item id
1159    
1160    ID code (e.g. C<d03>) of the relevant diagram.
1161    
1162    =item RETURN
1163    
1164    Returns TRUE if the diagram is in the new format, else FALSE.
1165    
1166    =back
1167    
1168    =cut
1169    
1170    sub is_new_diagram {
1171      my ($self, $id) = @_;
1172    
1173      my $image_map = $self->get_diagram_html_file($id);
1174      if ($image_map) {
1175        Trace("Image map found for diagram $id at $image_map.") if T(3);
1176        Open(\*IN, "<$image_map");
1177        my $header = <IN>;
1178        close(IN);
1179    
1180        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1181          return 1;
1182        }
1183      }
1184    
1185      return undef;
1186    }
1187    
1188    =head3 get_role_from_abbr
1189    
1190        my $roleName = $sub->get_role_from_abbr($abbr);
1191    
1192    Return the role name corresponding to an abbreviation.
1193    
1194    =over 4
1195    
1196    =item abbr
1197    
1198    Abbreviation name of the relevant role.
1199    
1200    =item RETURN
1201    
1202    Returns the full name of the specified role.
1203    
1204    =back
1205    
1206    =cut
1207    
1208    sub get_role_from_abbr {
1209        # Get the parameters.
1210        my($self, $abbr) = @_;
1211        # Get the role name from the abbreviation hash.
1212        my $retVal = $self->{abbrHash}->{$abbr};
1213        # Check for a case incompatability.
1214        if (! defined $retVal) {
1215            $retVal = $self->{abbrHash}->{lcfirst $abbr};
1216        }
1217        # Return the result.
1218        return $retVal;
1219    }
1220    
1221    
1222    =head3 get_name
1223    
1224        my $name = $sub->get_name();
1225    
1226    Return the name of this subsystem.
1227    
1228    =cut
1229    
1230    sub get_name {
1231        # Get the parameters.
1232        my ($self) = @_;
1233        # Return the result.
1234        return $self->{name};
1235    }
1236    
1237    =head3 open_diagram_image
1238    
1239        my ($type, $fh) = $sub->open_diagram_image($id);
1240    
1241    Open a diagram's image file and return the type and file handle.
1242    
1243    =over 4
1244    
1245    =item id
1246    
1247    ID of the desired diagram
1248    
1249    =item RETURN
1250    
1251    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1252    for the diagram's data. If the diagram does not exist, the type will be
1253    returned as <undef>.
1254    
1255    =back
1256    
1257    =cut
1258    
1259    sub open_diagram_image {
1260        # Get the parameters.
1261        my ($self, $id) = @_;
1262        # Declare the return variables.
1263        my ($type, $fh);
1264        # Get the diagram directory.
1265        my $img_base = "$self->{dir}/diagrams/$id/diagram";
1266        # Get a list of file extensions and types.
1267        my %types = (png => "image/png",
1268                     gif => "image/gif",
1269                     jpg => "image/jpeg");
1270        # This is my new syntax for the for-each-while loop.
1271        # We loop until we run out of keys or come up with a type value.
1272        for my $ext (keys %types) { last if (defined $type);
1273            my $myType = $types{$ext};
1274            # Compute a file name for this diagram.
1275            my $file = "$img_base.$ext";
1276            # If it exists, try to open it.
1277            if (-f $file) {
1278                $fh = Open(undef, "<$file");
1279                $type = $myType;
1280            }
1281        }
1282        # Return the result.
1283        return ($type, $fh);
1284    }
1285    
1286    =head3 get_hope_scenario_names
1287    
1288        my @names = $sub->get_hope_scenario_names();
1289    
1290    Return a list of the names for the scenarios associated with this
1291    subsystem.
1292    
1293    =cut
1294    
1295    sub get_hope_scenario_names {
1296        # Get the parameters.
1297        my ($self) = @_;
1298        # Get the names from the database.
1299        my $sprout = $self->{sprout};
1300        my @retVal = $sprout->GetFlat("HasScenario",
1301                                      "HasScenario(from-link) = ? ORDER BY HasScenario(to-link)",
1302                                      [$self->{name}], 'to-link');
1303        # Return the result.
1304        return @retVal;
1305    }
1306    
1307    =head3 get_hope_input_compounds
1308    
1309        my @compounds = $sub->get_hope_input_compounds($name);
1310    
1311    Return a list of the input compounds for the named hope scenario.
1312    
1313    =over 4
1314    
1315    =item name
1316    
1317    Name of a Hope scenario attached to this subsystem.
1318    
1319    =item RETURN
1320    
1321    Returns a list of compound IDs.
1322    
1323    =back
1324    
1325    =cut
1326    
1327    sub get_hope_input_compounds {
1328        # Get the parameters.
1329        my ($self, $name) = @_;
1330        # Ask for the compounds.
1331        my @retVal = $self->{sprout}->GetFlat("IsInputFor", "IsInputFor(to-link) = ?",
1332                                              [$name], "IsInputFor(from-link)");
1333        # Return the result.
1334        return @retVal;
1335    }
1336    
1337    =head3 get_hope_output_compounds
1338    
1339        my ($main, $aux) = $sub->get_hope_output_compounds($name);
1340    
1341    Return a list of the output compounds for the named hope scenario.
1342    
1343    =over 4
1344    
1345    =item name
1346    
1347    Name of the relevant scenario.
1348    
1349    =item RETURN
1350    
1351    Returns two lists of compound IDs: one for the main outputs and one for the
1352    auxiliary outputs.
1353    
1354    =back
1355    
1356    =cut
1357    
1358    sub get_hope_output_compounds {
1359        # Get the parameters.
1360        my ($self, $name) = @_;
1361        # Ask for the compounds.
1362        my $sprout = $self->{sprout};
1363        my @pairs = $sprout->GetAll("IsOutputOf", "IsOutputOf(to-link) = ?",
1364                                    [$name], "from-link auxiliary");
1365        # We now have a list of pairs in the form [name, aux-flag]. We put each
1366        # name in the list indicated by its aux-flag.
1367        my @retVal = ([], []);
1368        for my $pair (@pairs) {
1369            push @{$retVal[$pair->[1]]}, $pair->[0];
1370        }
1371        # Return the result.
1372        return @retVal;
1373    }
1374    
1375    =head3 get_hope_map_ids
1376    
1377        my @mapIDs = $sub->get_hope_map_ids($name);
1378    
1379    Return a list of the ID numbers for the diagrams associated with the named
1380    scenario.
1381    
1382    =over 4
1383    
1384    =item name
1385    
1386    Name of the relevant scenario.
1387    
1388    =item RETURN
1389    
1390    Returns a list of the ID numbers for the KEGG diagrams associated with this
1391    scenario. These are different from the diagram IDs, all of which begin with
1392    the string "map". This recognizes a design incompatability between SEED and
1393    Sprout.
1394    
1395    =back
1396    
1397    =cut
1398    
1399    sub get_hope_map_ids {
1400        # Get the parameters.
1401        my ($self, $name) = @_;
1402        # Get the map IDs.
1403        my @diagrams = $self->{sprout}->GetFlat('IsOnDiagram', "IsOnDiagram(from-link) = ?",
1404                                                [$name], 'to-link');
1405        # Modify and return the result.
1406        my @retVal = map { /(\d+)/ } @diagrams;
1407        return @retVal;
1408    }
1409    
1410    =head3 all_functions
1411    
1412        my $pegRoles = $sub->all_functions();
1413    
1414    Return a hash of all the features in the subsystem. The hash maps each
1415    feature ID to its functional assignment.
1416    
1417    =cut
1418    
1419    sub all_functions {
1420        # Get the parameters.
1421        my ($self) = @_;
1422        # Insure we have a spreadsheet.
1423        $self->_get_spreadsheet();
1424        # Return the feature hash.
1425        return $self->{featureData};
1426    }
1427    
1428    =head2 Internal Utility Methods
1429    
1430    =head3 _get_spreadsheet
1431    
1432        my $hash = $sub->_get_spreadsheet();
1433    
1434    Return a reference to a hash mapping each of the subsystem's genomes to
1435    their spreadsheet rows. Each row is a list of cells, and each cell is a
1436    list of feature IDs. This method also creates the color hash that maps PEGs
1437    to cluster numbers.
1438    
1439    =cut
1440    
1441    sub _get_spreadsheet {
1442        # Get the parameters.
1443        my ($self) = @_;
1444        # Do we already have a spreadsheet?
1445        my $retVal = $self->{rows};
1446        if (! defined $retVal) {
1447            # We don't, so we have to create one. Start with an empty hash.
1448            $retVal = {};
1449            # Ask for all the subsystem's cells and their features.
1450            my $query = $self->{sprout}->Get("HasSSCell SSCell ContainsFeature Feature",
1451                                             "HasSSCell(from-link) = ?",
1452                                             [$self->{name}]);
1453            # Loop through the features.
1454            while (my $feature = $query->Fetch()) {
1455                # Get the column number, the feature ID, and the cluster number.
1456                my $featureID = $feature->PrimaryValue('ContainsFeature(to-link)');
1457                my $cluster = $feature->PrimaryValue('ContainsFeature(cluster-number)');
1458                my $column = $feature->PrimaryValue('SSCell(column-number)');
1459                my $role = $feature->PrimaryValue('Feature(assignment)');
1460                # Compute the genome.
1461                my $genomeID = FIG::genome_of($featureID);
1462                # If we don't have this genome in the hash, create it.
1463                if (! exists $retVal->{$genomeID}) {
1464                    # The initial value is a list of empty lists. Features
1465                    # are then pushed into each individual list.
1466                    my @row = map { [] } @{$self->{roles}};
1467                    # Put this list of null lists in the hash.
1468                    $retVal->{$genomeID} = \@row;
1469                }
1470                # Get this row. We know now that it exists.
1471                my $row = $retVal->{$genomeID};
1472                # Add this feature to the appropriate cell in the row.
1473                push @{$row->[$column]}, $featureID;
1474                # Put it in the color hash and the feature data hash.
1475                $self->{colorHash}->{$featureID} = $cluster;
1476                $self->{featureData}->{$featureID} = $role;
1477            }
1478            # Save the row hash.
1479            $self->{rows} = $retVal;
1480      }      }
1481        # Return the result.
1482        return $retVal;
1483  }  }
1484    
1485    =head3 get_col
1486    
1487        my $cellArray = $sub->get_col($idx);
1488    
1489    Return an array of the cells in the specified column of the subsystem
1490    spreadsheet. Each cell is a reference to a list of the features for the
1491    corresponding row in the specified column.
1492    
1493    =over 4
1494    
1495    =item idx
1496    
1497    Index of the desired column.
1498    
1499    =item RETURN
1500    
1501    Returns a reference to a list containing the spreadsheet column's cells, in
1502    row order.
1503    
1504    =back
1505    
1506    =cut
1507    
1508    sub get_col {
1509        # Get the parameters.
1510        my ($self, $idx) = @_;
1511        # Declare the return variable.
1512        my @retVal;
1513        # Get the subsystem spreadsheet.
1514        my $sheet = $self->_get_spreadsheet();
1515        # Loop through the row list.
1516        for my $rowPair (@{$self->{genomes}}) {
1517            # Get the genome for this row. Each row pair is [genomeID, variantCode].
1518            my ($genomeID) = @$rowPair;
1519            # Get the genome's row in the spreadsheet.
1520            my $rowList = $sheet->{$genomeID};
1521            # Push this column's cell into the output list.
1522            push @retVal, $rowList->[$idx];
1523        }
1524        # Return the result.
1525        return \@retVal;
1526    }
1527    
1528  1;  1;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.23

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3