[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.9, Tue Oct 17 18:45:58 2006 UTC revision 1.14, Tue Apr 29 20:56:39 2008 UTC
# Line 69  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  =back  =back
78    
79  =cut  =cut
# Line 79  Line 84 
84    
85  =head3 new  =head3 new
86    
87  C<< my $sub = Subsystem->new($subName, $sprout); >>      my $sub = Subsystem->new($subName, $sprout);
88    
89  Load the subsystem.  Load the subsystem.
90    
# Line 106  Line 111 
111      }      }
112      # Declare the return value.      # Declare the return value.
113      my $retVal;      my $retVal;
114      # Get the subsystem's data fields.      # Get the subsystem's object.
115      my ($curator, $notes) = $sprout->GetEntityValues('Subsystem', $subName, ['Subsystem(curator)',      my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
116                                                                               'Subsystem(notes)']);      if (! defined $subsystemObject) {
117      # Only proceed if we found the subsystem.          # Here we're stuck.
118      if (defined $curator) {          Confess("Subsystem \"$subName\" not found in database.");
119        } else {
120            # We've found it, so get the major data.
121            my ($curator, $notes, $description) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
122                                                                            'Subsystem(description)']);
123          # 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
124          # 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
125          # and a subsystem variant code.          # and a subsystem variant code.
# Line 125  Line 134 
134          # 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
135          # 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
136          # 2-tuples will be ordered by the spreadsheet column number.          # 2-tuples will be ordered by the spreadsheet column number.
137          my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],          my @roles = $sprout->GetAll(['OccursInSubsystem'],
138                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
139                                      [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);                                      [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)']);
140          # Now we need to create the role ID directory and the reaction hash.          # Now we need to create the role ID directory and the reaction hash.
141          # The role ID directory maps role IDs and their abbreviations to column numbers.          # The role ID directory maps role IDs and their abbreviations to column numbers.
142          # The reaction hash maps a role ID to a list of the IDs for the reactions it          # The reaction hash maps a role ID to a list of the IDs for the reactions it
143          # catalyzes.          # catalyzes.
144          my %roleHash = ();          my %roleHash = ();
145            my %abbrHash = ();
146          my %reactionHash = ();          my %reactionHash = ();
147          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
148              # Get the role ID and abbreviation for this column's role.              # Get the role ID and abbreviation for this column's role.
# Line 140  Line 150 
150              # Put them both in the role directory.              # Put them both in the role directory.
151              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
152              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
153                # Put the full name in the abbreviation directory.
154                $abbrHash{$abbr} = $roleID;
155              # Get this role's reactions.              # Get this role's reactions.
156              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
157                                               [$roleID], 'Catalyzes(to-link)');                                               [$roleID], 'Catalyzes(to-link)');
# Line 174  Line 186 
186                      roles => \@roles,                      roles => \@roles,
187                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
188                      colorHash => {},                      colorHash => {},
189                        # Map of abbreviations to role names.
190                        abbrHash => \%abbrHash,
191                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
192                      reactionHash => \%reactionHash,                      reactionHash => \%reactionHash,
193                  };                  };
# Line 183  Line 197 
197      return $retVal;      return $retVal;
198  }  }
199    
200    =head3 get_row
201    
202        my $rowData = $sub->get_row($rowIndex);
203    
204    Return the specified row in the subsystem spreadsheet. The row consists
205    of a list of lists. Each position in the major list represents the role
206    for that position, and contains a list of the IDs for the features that
207    perform the role.
208    
209    =over 4
210    
211    =item rowIndex
212    
213    Index of the row to return. A row contains data for a single genome.
214    
215    =item RETURN
216    
217    Returns a reference to a list of lists. Each element in the list represents
218    a spreadsheet column (role) and contains a list of features that perform the
219    role.
220    
221    =back
222    
223    =cut
224    
225    sub get_row {
226        # Get the parameters.
227        my ($self, $rowIndex) = @_;
228        # Get the genome ID for the specified row's genome.
229        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
230        # Read the row from the database. We won't get exactly what we want. Instead, we'll
231        # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
232        # number. We need to convert this into a list of lists and stash the clustering information
233        # in the color hash.
234        my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
235                                              "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
236                                              [$self->{name}, $genomeID],
237                                              [qw(IsRoleOf(from-link) ContainsFeature(to-link)
238                                                  ContainsFeature(cluster-number))]);
239        # Now we do the conversion. We must first create an array of empty lists, one per
240        # row index.
241        my @retVal = map { [] } @{$self->{roles}};
242        # Get the hash for converting role IDs to role indexes.
243        my $roleHash = $self->{roleHash};
244        # Now we stash all the feature IDs in the appropriate columns of the row list.
245        for my $rowDatum (@rowData) {
246            # Get the role ID, the peg ID, and the cluster number.
247            my ($role, $peg, $cluster) = @{$rowDatum};
248            # Put the peg in the role's peg list.
249            push @{$retVal[$roleHash->{$role}]}, $peg;
250            # Put the cluster number in the color hash.
251            $self->{colorHash}->{$peg} = $cluster;
252        }
253        # Return the result.
254        return \@retVal;
255    }
256    
257    =head3 get_roles_for_genome
258    
259        my @roles = $sub->get_roles_for_genome($genome_id);
260    
261    Return a list of the roles in this subsystem that have nonempty
262    spreadsheet cells for the given genome.
263    
264    =over 4
265    
266    =item genome_id
267    
268    ID of the relevant genome.
269    
270    =item RETURN
271    
272    Returns a list of role IDs.
273    
274    =back
275    
276    =cut
277    
278    sub get_roles_for_genome {
279        # Get the parameters.
280        my ($self, $genome_id) = @_;
281        # This next statement gets all of the nonempty cells for the genome's row and memorizes
282        # the roles by rolling them into a hash. The query connects four relationship tables on
283        # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
284        # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
285        # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
286        # us the cell's role. If a cell has more than one feature, the result list from the query will return
287        # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
288        my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
289                                                              "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
290                                                              [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
291        # Return the result.
292        return keys %retVal;
293    }
294    
295    =head3 get_abbr_for_role
296    
297        my $abbr = $sub->get_abbr_for_role($name);
298    
299    Get this subsystem's abbreviation for the specified role.
300    
301    =over 4
302    
303    =item name
304    
305    Name of the relevant role.
306    
307    =item RETURN
308    
309    Returns the abbreviation for the role. Each subsystem has its own abbreviation
310    system; the abbreviations make it easier to display the subsystem spreadsheet.
311    
312    =back
313    
314    =cut
315    
316    sub get_abbr_for_role {
317        # Get the parameters.
318        my ($self, $name) = @_;
319        # Get the index for this role.
320        my $idx = $self->get_role_index($name);
321        # Return the abbreviation.
322        return $self->get_role_abbr($idx);
323    }
324    
325    =head3 get_subsetC
326    
327        my @columns = $sub->get_subsetC($subsetName);
328    
329    Return a list of the column numbers for the columns in the named role
330    subset.
331    
332    =over 4
333    
334    =item subsetName
335    
336    Name of the subset whose columns are desired.
337    
338    =item RETURN
339    
340    Returns a list of the indices for the columns in the named subset.
341    
342    =back
343    
344    =cut
345    
346    sub get_subsetC {
347        # Get the parameters.
348        my ($self, $subsetName) = @_;
349        # Get the roles in the subset.
350        my @roles = $self->get_subsetC_roles($subsetName);
351        # Convert them to indices.
352        my $roleHash = $self->{roleHash};
353        my @retVal = map { $roleHash->{$_} } @roles;
354        # Return the result.
355        return @retVal;
356    }
357    
358  =head3 get_genomes  =head3 get_genomes
359    
360  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
361    
362  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
363  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 205  Line 377 
377    
378  =head3 get_variant_code  =head3 get_variant_code
379    
380  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
381    
382  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
383  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 237  Line 409 
409    
410  =head3 get_curator  =head3 get_curator
411    
412  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
413    
414  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
415    
# Line 252  Line 424 
424    
425  =head3 get_notes  =head3 get_notes
426    
427  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
428    
429  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
430    
# Line 265  Line 437 
437      return $self->{notes};      return $self->{notes};
438  }  }
439    
440    =head3 get_description
441    
442        my $text = $sub->get_description();
443    
444    Return the description for this subsystem.
445    
446    =cut
447    
448    sub get_description
449    {
450        my($self) = @_;
451        return $self->{description};
452    }
453    
454  =head3 get_roles  =head3 get_roles
455    
456  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
457    
458  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
459  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 286  Line 472 
472    
473  =head3 get_reactions  =head3 get_reactions
474    
475  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
476    
477  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
478  catalyzed by the role.  catalyzed by the role.
# Line 302  Line 488 
488    
489  =head3 get_subset_namesC  =head3 get_subset_namesC
490    
491  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
492    
493  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
494  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 324  Line 510 
510      return @retVal;      return @retVal;
511  }  }
512    
513    =head3 get_subset_names
514    
515        my @subsetNames = $sub->get_subset_names();
516    
517    Return the names of the column subsets.
518    
519    =cut
520    
521    sub get_subset_names{
522        # Get the parameters.
523        my ($self) = @_;
524        # Return the result.
525        return $self->get_subset_namesC();
526    }
527    
528  =head3 get_role_abbr  =head3 get_role_abbr
529    
530  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
531    
532  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
533  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 355  Line 556 
556      return $retVal;      return $retVal;
557  }  }
558    
559    =head3 get_hope_reactions
560    
561        my %reactionHash = $subsys->get_hope_reactions();
562    
563    Return a hash mapping the roles of this subsystem to the EC numbers for
564    the reactions used in scenarios (if any). It may return an empty hash
565    if the Hope reactions are not yet known.
566    
567    =cut
568    
569    sub get_hope_reactions {
570        # Get the parameters.
571        my ($self) = @_;
572        # Try to get the hope reactions from the object.
573        my $retVal = $self->{hopeReactions};
574        if (! defined($retVal)) {
575            # They do not exist, so we must create them.
576            $retVal = FIGRules::GetHopeReactions($self, $self->{dir});
577            # Insure we have it if we need it again.
578            $self->{hopeReactions} = $retVal;
579        }
580        # Return the result.
581        return %{$retVal};
582    }
583    
584  =head3 get_role_index  =head3 get_role_index
585    
586  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
587    
588  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
589    
# Line 385  Line 611 
611    
612  =head3 get_subsetC_roles  =head3 get_subsetC_roles
613    
614  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
615    
616  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.
617    
# Line 423  Line 649 
649    
650  =head3 get_genome_index  =head3 get_genome_index
651    
652  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
653    
654  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
655    
# Line 452  Line 678 
678    
679  =head3 get_cluster_number  =head3 get_cluster_number
680    
681  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
682    
683  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
684  cluster number for the PEG is unknown or it is not clustered.  cluster number for the PEG is unknown or it is not clustered.
# Line 492  Line 718 
718    
719  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
720    
721  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
722    
723  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.
724    
# Line 559  Line 785 
785      return @retVal;      return @retVal;
786  }  }
787    
788    =head3 get_subsetR
789    
790        my @genomes = $sub->get_subsetR($subName);
791    
792    Return the genomes in the row subset indicated by the specified subset name.
793    
794    =over 4
795    
796    =item subName
797    
798    Name of the desired row subset, or C<All> to get all of the rows.
799    
800    =item RETURN
801    
802    Returns a list of genome IDs corresponding to the named subset.
803    
804    =back
805    
806    =cut
807    
808    sub get_subsetR {
809        # Get the parameters.
810        my ($self, $subName) = @_;
811        # Look for the specified row subset in the database. A row subset is identified using
812        # the subsystem name and the subset name. The special subset "All" is actually
813        # represented in the database, so we don't need to check for it.
814        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
815                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
816        return @rows;
817    }
818    
819  =head3 get_diagrams  =head3 get_diagrams
820    
821  C<< my @list = $sub->get_diagrams(); >>      my @list = $sub->get_diagrams();
822    
823  Return a list of the diagrams associated with this subsystem. Each diagram  Return a list of the diagrams associated with this subsystem. Each diagram
824  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 617  Line 872 
872    
873  =head3 get_diagram  =head3 get_diagram
874    
875  C<< my ($name, $pageURL, $imgURL) = $sub->get_diagram($id); >>      my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
876    
877  Get the information (if any) for the specified diagram. The diagram corresponds  Get the information (if any) for the specified diagram. The diagram corresponds
878  to a subdirectory of the subsystem's C<diagrams> directory. For example, if the  to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
# Line 645  Line 900 
900  sub get_diagram {  sub get_diagram {
901      my($self, $id) = @_;      my($self, $id) = @_;
902      my $name = Subsystem::GetDiagramName($self->{dir}, $id);      my $name = Subsystem::GetDiagramName($self->{dir}, $id);
903      my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self->{name}, $id, 1);      my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
904      return($name, $link, $img_link);      return($name, $link, $img_link);
905  }  }
906    
907    
908  =head3 get_diagram_html_file  =head3 get_diagram_html_file
909    
910  C<< my $fileName = $sub->get_diagram_html_file($id); >>      my $fileName = $sub->get_diagram_html_file($id);
911    
912  Get the HTML file (if any) for the specified diagram. The diagram corresponds  Get the HTML file (if any) for the specified diagram. The diagram corresponds
913  to a subdirectory of the subsystem's C<diagrams> directory. For example, if the  to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
# Line 687  Line 942 
942      return $retVal;      return $retVal;
943  }  }
944    
945    =head3 is_new_diagram
946    
947        my $flag = $sub->is_new_diagram($id);
948    
949    Return TRUE if the specified diagram is in the new format, else FALSE.
950    
951    =over 4
952    
953    =item id
954    
955    ID code (e.g. C<d03>) of the relevant diagram.
956    
957    =item RETURN
958    
959    Returns TRUE if the diagram is in the new format, else FALSE.
960    
961    =back
962    
963    =cut
964    
965    sub is_new_diagram {
966      my ($self, $id) = @_;
967    
968      my $image_map = $self->get_diagram_html_file($id);
969      if ($image_map) {
970        Trace("Image map found for diagram $id at $image_map.") if T(3);
971        open(IN, "$image_map") or Confess("Unable to open file $image_map.");
972        my $header = <IN>;
973        close(IN);
974    
975        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
976          return 1;
977        }
978      }
979    
980      return undef;
981    }
982    
983    =head3 get_role_from_abbr
984    
985        my $roleName = $sub->get_role_from_abbr($abbr);
986    
987    Return the role name corresponding to an abbreviation.
988    
989    =over 4
990    
991    =item abbr
992    
993    Abbreviation name of the relevant role.
994    
995    =item RETURN
996    
997    Returns the full name of the specified role.
998    
999    =back
1000    
1001    =cut
1002    
1003    sub get_role_from_abbr {
1004        # Get the parameters.
1005        my($self, $abbr) = @_;
1006        # Get the role name from the abbreviation hash.
1007        my $retVal = $self->{abbrHash}->{$abbr};
1008        # Check for a case incompatability.
1009        if (! defined $retVal) {
1010            $retVal = $self->{abbrHash}->{lcfirst $abbr};
1011        }
1012        # Return the result.
1013        return $retVal;
1014    }
1015    
1016    
1017  =head3 get_name  =head3 get_name
1018    
1019  C<< my $name = $sub->get_name(); >>      my $name = $sub->get_name();
1020    
1021  Return the name of this subsystem.  Return the name of this subsystem.
1022    
# Line 704  Line 1031 
1031    
1032  =head3 open_diagram_image  =head3 open_diagram_image
1033    
1034  C<< my ($type, $fh) = $sub->open_diagram_image($id); >>      my ($type, $fh) = $sub->open_diagram_image($id);
1035    
1036  Open a diagram's image file and return the type and file handle.  Open a diagram's image file and return the type and file handle.
1037    

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3