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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.20 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package SproutSubsys;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use PageBuilder;
8 :     use FIG;
9 :     use Sprout;
10 :    
11 :     =head1 Sprout Subsystem Object
12 :    
13 :     =head2 Introduction
14 :    
15 :     This object emulates the capabilities of the FIG-style C<Subsystem> object, but
16 :     uses Sprout methods to retrieve the data. This object can be dropped in place of
17 :     the UnvSubsys object to create subsystem displays for the Sprout rather than the
18 :     SEED.
19 :    
20 :     The structure created by the constructor contains the following data members.
21 :    
22 :     =over 4
23 :    
24 :     =item name
25 :    
26 :     Name of the subsystem. This is needed for any further database accesses required.
27 :    
28 :     =item curator
29 :    
30 :     Name of the subsystem's official curator.
31 :    
32 :     =item notes
33 :    
34 :     General notes about the subsystem.
35 :    
36 :     =item sprout
37 :    
38 :     Sprout object for accessing the database. This is a genuine Sprout object, not
39 :     an SFXlate object.
40 :    
41 :     =item genomeHash
42 :    
43 :     Map of genome IDs to row indices.
44 :    
45 :     =item genomes
46 :    
47 :     List of [genomeID, variantCode] tuples in row order.
48 :    
49 :     =item roleHash
50 :    
51 :     Map of role IDs and abbreviations to column indices. In other words, plugging
52 :     either a full-blown role ID or its abbreviation into this hash will return
53 :     the role's column index.
54 :    
55 :     =item roles
56 :    
57 :     List of [roleID, abbreviation] tuples in column order.
58 :    
59 : parrello 1.9 =item dir
60 :    
61 :     Directory root for the diagram and image files.
62 :    
63 : parrello 1.1 =item reactionHash
64 :    
65 :     Map of role IDs to a list of the reactions catalyzed by the role.
66 :    
67 :     =item colorHash
68 :    
69 :     Map of PEG IDs to cluster numbers. This is used to create color maps for
70 :     display of a subsystem's PEGs.
71 :    
72 : parrello 1.12 =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 : parrello 1.1 =back
78 :    
79 :     =cut
80 :    
81 :     #: Constructor SproutSubsys->new();
82 :    
83 :     =head2 Public Methods
84 :    
85 :     =head3 new
86 :    
87 : parrello 1.18 my $sub = SproutSubsys->new($subName, $sprout);
88 : parrello 1.1
89 :     Load the subsystem.
90 :    
91 :     =over 4
92 :    
93 :     =item subName
94 :    
95 :     Name of the desired subsystem.
96 :    
97 :     =item sprout
98 :    
99 :     Sprout or SFXlate object for accessing the Sprout data store.
100 :    
101 :     =back
102 :    
103 :     =cut
104 :    
105 :     sub new {
106 :     # Get the parameters.
107 :     my ($class, $subName, $sprout) = @_;
108 :     # Insure we have a Sprout object.
109 :     if (ref $sprout eq 'SFXlate') {
110 :     $sprout = $sprout->{sprout};
111 :     }
112 :     # Declare the return value.
113 :     my $retVal;
114 : parrello 1.14 # Get the subsystem's object.
115 :     my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
116 :     if (! defined $subsystemObject) {
117 :     # Here we're stuck.
118 :     Confess("Subsystem \"$subName\" not found in database.");
119 :     } else {
120 :     # We've found it, so get the major data.
121 : parrello 1.18 my ($curator, $notes, $description, $version) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
122 :     'Subsystem(description)', 'Subsystem(version)']);
123 : parrello 1.1 # 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
125 :     # and a subsystem variant code.
126 :     my @genomes = $sprout->GetAll(['ParticipatesIn'],
127 :     'ParticipatesIn(to-link) = ? ORDER BY ParticipatesIn(variant-code), ParticipatesIn(from-link)',
128 :     [$subName], ['ParticipatesIn(from-link)',
129 :     'ParticipatesIn(variant-code)']);
130 :     # Create the genome ID directory. This is a hash that maps a genome ID to its
131 :     # row index.
132 :     my $idx = 0;
133 :     my %genomeHash = map { $_->[0] => $idx++ } @genomes;
134 :     # 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
136 :     # 2-tuples will be ordered by the spreadsheet column number.
137 : parrello 1.11 my @roles = $sprout->GetAll(['OccursInSubsystem'],
138 : parrello 1.1 'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
139 : parrello 1.18 [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)',
140 :     'OccursInSubsystem(auxiliary)']);
141 : parrello 1.19 # Now we need to create the role ID directory, which maps role IDs and their
142 :     # abbreviations to column numbers.
143 : parrello 1.1 my %roleHash = ();
144 : parrello 1.11 my %abbrHash = ();
145 : parrello 1.18 my %auxHash = ();
146 : parrello 1.1 for ($idx = 0; $idx <= $#roles; $idx++) {
147 : parrello 1.18 # Get the role ID, aux flag, and abbreviation for this column's role.
148 :     my ($roleID, $abbr, $aux) = @{$roles[$idx]};
149 :     # Put the ID and abbreviation in the role directory.
150 : parrello 1.1 $roleHash{$roleID} = $idx;
151 :     $roleHash{$abbr} = $idx;
152 : parrello 1.18 # Put the aux flag in the aux hash.
153 :     $auxHash{$roleID} = $aux;
154 : parrello 1.11 # Put the full name in the abbreviation directory.
155 :     $abbrHash{$abbr} = $roleID;
156 : parrello 1.1 }
157 : parrello 1.9 # Find the subsystem directory.
158 :     my $subDir = Subsystem::get_dir_from_name($subName);
159 :     Trace("Subsystem directory is $subDir.") if T(3);
160 : parrello 1.1 # Create the subsystem object.
161 :     $retVal = {
162 :     # Name of the subsystem. This is needed for any further database
163 :     # accesses required.
164 :     name => $subName,
165 : parrello 1.9 # Directory root for diagram and image files.
166 :     dir => $subDir,
167 : parrello 1.1 # Name of the subsystem's official curator.
168 :     curator => $curator,
169 :     # General notes about the subsystem.
170 :     notes => $notes,
171 :     # Sprout object for accessing the database.
172 :     sprout => $sprout,
173 :     # Map of genome IDs to row indices.
174 :     genomeHash => \%genomeHash,
175 :     # List of [genomeID, variantCode] tuples in row order.
176 :     genomes => \@genomes,
177 :     # Map of role IDs and abbreviations to column indices.
178 :     roleHash => \%roleHash,
179 :     # List of [roleID, abbreviation] tuples in column order.
180 :     roles => \@roles,
181 :     # Map of PEG IDs to cluster numbers.
182 :     colorHash => {},
183 : parrello 1.11 # Map of abbreviations to role names.
184 :     abbrHash => \%abbrHash,
185 : parrello 1.18 # Map of auxiliary rols.
186 :     auxHash => \%auxHash,
187 : parrello 1.2 # Map of role IDs to reactions.
188 : parrello 1.19 reactionHash => undef,
189 : parrello 1.18 # Version number.
190 :     version => $version,
191 : parrello 1.1 };
192 :     # Bless and return it.
193 :     bless $retVal, $class;
194 :     }
195 :     return $retVal;
196 :     }
197 :    
198 : parrello 1.18 =head3 is_aux_role
199 :    
200 :     my $flag = $sub->is_aux_role($roleID);
201 :    
202 :     Return TRUE if the specified role is auxiliary to this subsystem, FALSE
203 :     if it is essential to it.
204 :    
205 :     =over 4
206 :    
207 :     =item roleID
208 :    
209 :     ID of the relevant role.
210 :    
211 :     =item RETURN
212 :    
213 :     Returns TRUE if the specified role is auxiliary, else FALSE.
214 :    
215 :     =back
216 :    
217 :     =cut
218 :    
219 :     sub is_aux_role {
220 :     # Get the parameters.
221 :     my ($self, $roleID) = @_;
222 :     # Declare the return variable.
223 :     my $retVal = $self->{auxHash}->{$roleID};
224 :     # Return the result.
225 :     return $retVal;
226 :     }
227 :    
228 :    
229 : parrello 1.12 =head3 get_row
230 :    
231 :     my $rowData = $sub->get_row($rowIndex);
232 :    
233 :     Return the specified row in the subsystem spreadsheet. The row consists
234 :     of a list of lists. Each position in the major list represents the role
235 :     for that position, and contains a list of the IDs for the features that
236 :     perform the role.
237 :    
238 :     =over 4
239 :    
240 :     =item rowIndex
241 :    
242 :     Index of the row to return. A row contains data for a single genome.
243 :    
244 :     =item RETURN
245 :    
246 :     Returns a reference to a list of lists. Each element in the list represents
247 :     a spreadsheet column (role) and contains a list of features that perform the
248 :     role.
249 :    
250 :     =back
251 :    
252 :     =cut
253 :    
254 :     sub get_row {
255 :     # Get the parameters.
256 :     my ($self, $rowIndex) = @_;
257 :     # Get the genome ID for the specified row's genome.
258 :     my $genomeID = $self->{genomes}->[$rowIndex]->[0];
259 :     # Read the row from the database. We won't get exactly what we want. Instead, we'll
260 :     # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
261 :     # number. We need to convert this into a list of lists and stash the clustering information
262 :     # in the color hash.
263 :     my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
264 :     "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
265 :     [$self->{name}, $genomeID],
266 :     [qw(IsRoleOf(from-link) ContainsFeature(to-link)
267 :     ContainsFeature(cluster-number))]);
268 :     # Now we do the conversion. We must first create an array of empty lists, one per
269 :     # row index.
270 :     my @retVal = map { [] } @{$self->{roles}};
271 :     # Get the hash for converting role IDs to role indexes.
272 :     my $roleHash = $self->{roleHash};
273 :     # Now we stash all the feature IDs in the appropriate columns of the row list.
274 :     for my $rowDatum (@rowData) {
275 :     # Get the role ID, the peg ID, and the cluster number.
276 :     my ($role, $peg, $cluster) = @{$rowDatum};
277 :     # Put the peg in the role's peg list.
278 :     push @{$retVal[$roleHash->{$role}]}, $peg;
279 :     # Put the cluster number in the color hash.
280 :     $self->{colorHash}->{$peg} = $cluster;
281 :     }
282 :     # Return the result.
283 :     return \@retVal;
284 :     }
285 :    
286 : parrello 1.14 =head3 get_roles_for_genome
287 :    
288 :     my @roles = $sub->get_roles_for_genome($genome_id);
289 :    
290 :     Return a list of the roles in this subsystem that have nonempty
291 :     spreadsheet cells for the given genome.
292 :    
293 :     =over 4
294 :    
295 :     =item genome_id
296 :    
297 :     ID of the relevant genome.
298 :    
299 :     =item RETURN
300 :    
301 :     Returns a list of role IDs.
302 :    
303 :     =back
304 :    
305 :     =cut
306 :    
307 :     sub get_roles_for_genome {
308 :     # Get the parameters.
309 :     my ($self, $genome_id) = @_;
310 :     # This next statement gets all of the nonempty cells for the genome's row and memorizes
311 :     # the roles by rolling them into a hash. The query connects four relationship tables on
312 :     # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
313 :     # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
314 :     # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
315 :     # us the cell's role. If a cell has more than one feature, the result list from the query will return
316 :     # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
317 :     my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
318 :     "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
319 :     [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
320 :     # Return the result.
321 :     return keys %retVal;
322 :     }
323 :    
324 : parrello 1.12 =head3 get_abbr_for_role
325 :    
326 :     my $abbr = $sub->get_abbr_for_role($name);
327 :    
328 :     Get this subsystem's abbreviation for the specified role.
329 :    
330 :     =over 4
331 :    
332 :     =item name
333 :    
334 :     Name of the relevant role.
335 :    
336 :     =item RETURN
337 :    
338 :     Returns the abbreviation for the role. Each subsystem has its own abbreviation
339 :     system; the abbreviations make it easier to display the subsystem spreadsheet.
340 :    
341 :     =back
342 :    
343 :     =cut
344 :    
345 : parrello 1.14 sub get_abbr_for_role {
346 : parrello 1.12 # Get the parameters.
347 :     my ($self, $name) = @_;
348 :     # Get the index for this role.
349 :     my $idx = $self->get_role_index($name);
350 :     # Return the abbreviation.
351 :     return $self->get_role_abbr($idx);
352 :     }
353 :    
354 :     =head3 get_subsetC
355 :    
356 :     my @columns = $sub->get_subsetC($subsetName);
357 :    
358 :     Return a list of the column numbers for the columns in the named role
359 :     subset.
360 :    
361 :     =over 4
362 :    
363 :     =item subsetName
364 :    
365 :     Name of the subset whose columns are desired.
366 :    
367 :     =item RETURN
368 :    
369 :     Returns a list of the indices for the columns in the named subset.
370 :    
371 :     =back
372 :    
373 :     =cut
374 :    
375 :     sub get_subsetC {
376 :     # Get the parameters.
377 :     my ($self, $subsetName) = @_;
378 :     # Get the roles in the subset.
379 :     my @roles = $self->get_subsetC_roles($subsetName);
380 :     # Convert them to indices.
381 :     my $roleHash = $self->{roleHash};
382 :     my @retVal = map { $roleHash->{$_} } @roles;
383 :     # Return the result.
384 :     return @retVal;
385 :     }
386 :    
387 : parrello 1.1 =head3 get_genomes
388 :    
389 : parrello 1.12 my @genomeList = $sub->get_genomes();
390 : parrello 1.1
391 :     Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
392 :     in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
393 :     in the specified row.
394 :    
395 :     =cut
396 :    
397 :     sub get_genomes {
398 :     # Get the parameters.
399 :     my ($self) = @_;
400 :     # Return a list of the genome IDs. The "genomes" member contains a 2-tuple
401 :     # with the genome ID followed by the variant code. We only return the
402 :     # genome IDs.
403 :     my @retVal = map { $_->[0] } @{$self->{genomes}};
404 :     return @retVal;
405 :     }
406 :    
407 :     =head3 get_variant_code
408 :    
409 : parrello 1.12 my $code = $sub->get_variant_code($gidx);
410 : parrello 1.1
411 :     Return the variant code for the specified genome. Each subsystem has multiple
412 :     variants which involve slightly different chemical reactions, and each variant
413 :     has an associated variant code. When a genome is connected to the spreadsheet,
414 :     the subsystem variant used by the genome must be specified.
415 :    
416 :     =over 4
417 :    
418 :     =item gidx
419 :    
420 :     Row index for the genome whose variant code is desired.
421 :    
422 :     =item RETURN
423 :    
424 :     Returns the variant code for the specified genome.
425 :    
426 :     =back
427 :    
428 :     =cut
429 :    
430 :     sub get_variant_code {
431 :     # Get the parameters.
432 :     my ($self, $gidx) = @_;
433 :     # Extract the variant code for the specified row index. It is the second
434 :     # element of the tuple from the "genomes" member.
435 : parrello 1.5 my $retVal = $self->{genomes}->[$gidx]->[1];
436 : parrello 1.1 return $retVal;
437 :     }
438 :    
439 :     =head3 get_curator
440 :    
441 : parrello 1.12 my $userName = $sub->get_curator();
442 : parrello 1.1
443 :     Return the name of this subsystem's official curator.
444 :    
445 :     =cut
446 :    
447 :     sub get_curator {
448 :     # Get the parameters.
449 :     my ($self) = @_;
450 :     # Return the curator member.
451 :     return $self->{curator};
452 :     }
453 :    
454 :     =head3 get_notes
455 :    
456 : parrello 1.12 my $text = $sub->get_notes();
457 : parrello 1.1
458 :     Return the descriptive notes for this subsystem.
459 :    
460 :     =cut
461 :    
462 :     sub get_notes {
463 :     # Get the parameters.
464 :     my ($self) = @_;
465 :     # Return the notes member.
466 :     return $self->{notes};
467 :     }
468 :    
469 : parrello 1.13 =head3 get_description
470 :    
471 :     my $text = $sub->get_description();
472 :    
473 :     Return the description for this subsystem.
474 :    
475 :     =cut
476 :    
477 :     sub get_description
478 :     {
479 :     my($self) = @_;
480 :     return $self->{description};
481 :     }
482 :    
483 : parrello 1.1 =head3 get_roles
484 :    
485 : parrello 1.12 my @roles = $sub->get_roles();
486 : parrello 1.1
487 :     Return a list of the subsystem's roles. Each role corresponds to a column
488 :     in the subsystem spreadsheet. The list entry at a specified position in
489 :     the list will contain the ID of that column's role.
490 :    
491 :     =cut
492 :    
493 :     sub get_roles {
494 :     # Get the parameters.
495 :     my ($self) = @_;
496 :     # Return the list of role IDs. The role IDs are stored as the first
497 :     # element of each 2-tuple in the "roles" member.
498 :     my @retVal = map { $_->[0] } @{$self->{roles}};
499 :     return @retVal;
500 :     }
501 :    
502 :     =head3 get_reactions
503 :    
504 : parrello 1.12 my $reactHash = $sub->get_reactions();
505 : parrello 1.1
506 :     Return a reference to a hash that maps each role ID to a list of the reactions
507 :     catalyzed by the role.
508 :    
509 :     =cut
510 :    
511 :     sub get_reactions {
512 :     # Get the parameters.
513 :     my ($self) = @_;
514 : parrello 1.19 # Do we already have a reaction hash?
515 :     my $retVal = $self->{reactionHash};
516 :     if (! $retVal) {
517 :     # No, so we'll build it.
518 :     $retVal = {};
519 :     my $sprout = $self->{sprout};
520 :     for my $roleID ($self->get_roles()) {
521 :     # Get this role's reactions.
522 :     my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
523 :     [$roleID], 'Catalyzes(to-link)');
524 :     # Put them in the reaction hash.
525 :     if (@reactions > 0) {
526 :     $retVal->{$roleID} = \@reactions;
527 :     }
528 :     }
529 :     # Save it for future use.
530 :     $self->{reactionHash} = $retVal;
531 :     }
532 :     # Return the reaction hash.
533 :     return $retVal;
534 : parrello 1.1 }
535 :    
536 :     =head3 get_subset_namesC
537 :    
538 : parrello 1.12 my @subsetNames = $sub->get_subset_namesC();
539 : parrello 1.1
540 :     Return a list of the names for all the column (role) subsets. Given a subset
541 :     name, you can use the L</get_subsetC_roles> method to get the roles in the
542 :     subset.
543 :    
544 :     =cut
545 :    
546 :     sub get_subset_namesC {
547 :     # Get the parameters.
548 :     my ($self) = @_;
549 :     # Get the sprout object and use it to retrieve the subset names.
550 :     my $sprout = $self->{sprout};
551 :     my @subsets = $sprout->GetFlat(['HasRoleSubset'], 'HasRoleSubset(from-link) = ?',
552 :     [$self->{name}], 'HasRoleSubset(to-link)');
553 :     # The sprout subset names are prefixed by the subsystem name. We need to pull the
554 :     # prefix off before we return the results. The prefixing character is a colon (:),
555 :     # so we search for the last colon to get ourselves the true subset name.
556 :     my @retVal = map { $_ =~ /:([^:]+)$/; $1 } @subsets;
557 :     return @retVal;
558 :     }
559 :    
560 : parrello 1.12 =head3 get_subset_names
561 :    
562 :     my @subsetNames = $sub->get_subset_names();
563 :    
564 :     Return the names of the column subsets.
565 :    
566 :     =cut
567 :    
568 :     sub get_subset_names{
569 :     # Get the parameters.
570 :     my ($self) = @_;
571 :     # Return the result.
572 :     return $self->get_subset_namesC();
573 :     }
574 :    
575 : parrello 1.1 =head3 get_role_abbr
576 :    
577 : parrello 1.12 my $abbr = $sub->get_role_abbr($ridx);
578 : parrello 1.1
579 :     Return the abbreviation for the role in the specified column. The abbreviation
580 :     is a shortened identifier that is not necessarily unique, but is more likely to
581 :     fit in a column heading.
582 :    
583 :     =over 4
584 :    
585 :     =item ridx
586 :    
587 :     Column index for the role whose abbreviation is desired.
588 :    
589 :     =item RETURN
590 :    
591 :     Returns an abbreviated name for the role corresponding to the indexed column.
592 :    
593 :     =back
594 :    
595 :     =cut
596 :    
597 :     sub get_role_abbr {
598 :     # Get the parameters.
599 :     my ($self, $ridx) = @_;
600 :     # Return the role abbreviation. The abbreviation is the second element
601 :     # in the 2-tuple for the specified column in the "roles" member.
602 :     my $retVal = $self->{roles}->[$ridx]->[1];
603 :     return $retVal;
604 :     }
605 :    
606 : parrello 1.15
607 :     =head3 get_hope_reactions_for_genome
608 :    
609 :     my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
610 :    
611 :     This method returns a hash that maps reactions to the pegs that catalyze
612 :     them for the specified genome. For each role in the subsystem, the pegs
613 :     are computed, and these are attached to the reactions for the role.
614 :    
615 :     =over 4
616 :    
617 :     =item genome
618 :    
619 :     ID of the genome whose reactions are to be put into the hash.
620 :    
621 :     =item RETURN
622 :    
623 :     Returns a hash mapping reactions in the subsystem to pegs in the
624 : parrello 1.19 specified genome, or an empty hash if the genome is not found in the
625 : parrello 1.15 subsystem.
626 :    
627 :     =back
628 :    
629 :     =cut
630 :    
631 :     sub get_hope_reactions_for_genome {
632 : parrello 1.19 # Get the parameters.
633 : parrello 1.15 my($self, $genome) = @_;
634 : parrello 1.19 # Declare the return variable.
635 :     my %retVal;
636 :     # Look for the genome in our spreadsheet.
637 :     my $index = $self->get_genome_index($genome);
638 :     # Only proceed if we found it.
639 : parrello 1.15 if (defined $index) {
640 : parrello 1.19 # Extract the roles.
641 :     my @roles = $self->get_roles;
642 :     # Get the hope reaction hash. For each role, this gives us a list
643 :     # of reactions.
644 :     my %hope_reactions = $self->get_hope_reactions();
645 :     # Loop through the cells in this genome's role.
646 :     for my $role (@roles) {
647 :     # Get the features in this role's cell.
648 :     my @peg_list = $self->get_pegs_from_cell($genome,$role);
649 :     # Only proceed if we have hope reactions AND pegs for this role.
650 :     if (defined $hope_reactions{$role} && scalar @peg_list > 0) {
651 :     # Loop through the reactions, pushing the pegs in this cell onto
652 :     # the reaction's peg list.
653 :     for my $reaction (@{$hope_reactions{$role}}) {
654 :     push @{$retVal{$reaction}}, @peg_list;
655 :     }
656 :     }
657 :     }
658 : parrello 1.15 }
659 : parrello 1.19 # Return the result.
660 :     return %retVal;
661 : parrello 1.15 }
662 :    
663 :    
664 :     =head3 get_hope_additional_reactions
665 :    
666 :     my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
667 :    
668 :     Return a list of the additional reactions for the specified scenario.
669 :    
670 :     =over 4
671 :    
672 :     =item scenario_name
673 :    
674 :     Name of the scenario whose additional reactions are desired.
675 :    
676 :     =item RETURN
677 :    
678 :     Returns a list of the additional reactions attached to the named scenario.
679 :    
680 :     =back
681 :    
682 :     =cut
683 :    
684 : parrello 1.19 sub get_hope_additional_reactions {
685 :     # Get the parameters.
686 :     my($self, $scenario_name) = @_;
687 :     # Ask the database for this scenario's additional reactions.
688 :     my @retVal = $self->{sprout}->GetFlat(['IncludesReaction'], "IncludesReaction(from-link) = ?",
689 :     [$scenario_name], 'IncludesReaction(to-link)');
690 : parrello 1.15 return @retVal;
691 :     }
692 :    
693 :    
694 : parrello 1.12 =head3 get_hope_reactions
695 :    
696 : parrello 1.14 my %reactionHash = $subsys->get_hope_reactions();
697 : parrello 1.12
698 :     Return a hash mapping the roles of this subsystem to the EC numbers for
699 :     the reactions used in scenarios (if any). It may return an empty hash
700 :     if the Hope reactions are not yet known.
701 :    
702 :     =cut
703 :    
704 :     sub get_hope_reactions {
705 :     # Get the parameters.
706 :     my ($self) = @_;
707 :     # Try to get the hope reactions from the object.
708 :     my $retVal = $self->{hopeReactions};
709 :     if (! defined($retVal)) {
710 : parrello 1.19 # They do not exist, so we must create them. Make a copy of the role-to-reaction
711 :     # hash.
712 :     my %hopeHash = %{$self->get_reactions()};
713 : parrello 1.12 # Insure we have it if we need it again.
714 : parrello 1.19 $retVal = \%hopeHash;
715 : parrello 1.12 $self->{hopeReactions} = $retVal;
716 :     }
717 :     # Return the result.
718 : parrello 1.14 return %{$retVal};
719 : parrello 1.12 }
720 :    
721 : parrello 1.18 =head3 get_hope_reaction_notes
722 :    
723 :     my %roleHash = $sub->get_hope_reaction_notes();
724 :    
725 :     Return a hash mapping the roles of the subsystem to any existing notes
726 :     about the relevant reactions.
727 :    
728 :     =cut
729 :    
730 :     sub get_hope_reaction_notes {
731 :     # Get the parameters.
732 :     my ($self) = @_;
733 :     # Declare the return variable.
734 :     my %retVal;
735 : parrello 1.19 # Get the database object.
736 :     my $sprout = $self->{sprout};
737 :     # Get our name.
738 :     my $ssName = $self->{name};
739 :     # Loop through the roles, getting each role's hope notes.
740 :     for my $role ($self->get_roles()) {
741 :     my ($note) = $self->get_hop_reaction_note($role);
742 :     # If this role had a nonempty note, stuff it in the hash.
743 :     if ($note) {
744 :     $retVal{$role} = $note;
745 :     }
746 :     }
747 : parrello 1.18 # Return the result.
748 :     return %retVal;
749 :     }
750 :    
751 :     =head3 get_hope_reaction_note
752 :    
753 :     my $note = $sub->get_hope_reaction_note($role);
754 :    
755 :     Return the text note about the curation of the scenario reactions
756 :     relating to this role.
757 :    
758 :     =over 4
759 :    
760 :     =item role
761 :    
762 : parrello 1.19 ID of the role whose note is desired.
763 : parrello 1.18
764 :     =item RETURN
765 :    
766 : parrello 1.19 Returns the relevant role's note for this subsystem's hope reactions, or FALSE (empty string
767 :     or undefined) if no such note was found.
768 : parrello 1.18
769 :     =back
770 :    
771 :     =cut
772 :    
773 :     sub get_hope_reaction_note {
774 :     # Get the parameters.
775 :     my ($self, $role) = @_;
776 : parrello 1.19 # Ask the database for the note.
777 :     my ($retVal) = $self->{sprout}->GetFlat(['OccursInSubsystem'],
778 :     "OccursInSubsystem(from-link) = ? AND OccursInSubsystem(to-link) = ?",
779 :     [$role, $self->{name}], 'OccursInSubsystem(hope-reaction-note)');
780 : parrello 1.18 # Return the result.
781 :     return $retVal;
782 :     }
783 :    
784 : parrello 1.1 =head3 get_role_index
785 :    
786 : parrello 1.12 my $idx = $sub->get_role_index($role);
787 : parrello 1.1
788 :     Return the column index for the role with the specified ID.
789 :    
790 :     =over 4
791 :    
792 :     =item role
793 :    
794 :     ID (full name) or abbreviation of the role whose column index is desired.
795 :    
796 :     =item RETURN
797 :    
798 :     Returns the column index for the role with the specified name or abbreviation.
799 :    
800 :     =back
801 :    
802 :     =cut
803 :    
804 :     sub get_role_index {
805 :     # Get the parameters.
806 :     my ($self, $role) = @_;
807 :     # The role index is directly available from the "roleHash" member.
808 :     my $retVal = $self->{roleHash}->{$role};
809 :     return $retVal;
810 :     }
811 :    
812 :     =head3 get_subsetC_roles
813 :    
814 : parrello 1.12 my @roles = $sub->get_subsetC_roles($subname);
815 : parrello 1.1
816 :     Return the names of the roles contained in the specified role (column) subset.
817 :    
818 :     =over 4
819 :    
820 :     =item subname
821 :    
822 :     Name of the role subset whose roles are desired.
823 :    
824 :     =item RETURN
825 :    
826 :     Returns a list of the role names for the columns in the named subset.
827 :    
828 :     =back
829 :    
830 :     =cut
831 :    
832 :     sub get_subsetC_roles {
833 :     # Get the parameters.
834 :     my ($self, $subname) = @_;
835 :     # Get the sprout object. We need it to be able to get the subset data.
836 :     my $sprout = $self->{sprout};
837 :     # Convert the subset name to Sprout format. In Sprout, the subset name is
838 :     # prefixed by the subsystem name in order to get a unique subset ID.
839 :     my $subsetID = $self->{name} . ":$subname";
840 :     # Get a list of the role names for this subset.
841 :     my @roleNames = $sprout->GetFlat(['ConsistsOfRoles'], 'ConsistsOfRoles(from-link) = ?',
842 :     [$subsetID], 'ConsistsOfRoles(to-link)');
843 :     # Sort them by column number. We get the column number from the role hash.
844 :     my $roleHash = $self->{roleHash};
845 :     my @retVal = sort { $roleHash->{$a} <=> $roleHash->{$b} } @roleNames;
846 :     # Return the sorted list.
847 :     return @retVal;
848 :     }
849 :    
850 :     =head3 get_genome_index
851 :    
852 : parrello 1.12 my $idx = $sub->get_genome_index($genome);
853 : parrello 1.1
854 :     Return the row index for the genome with the specified ID.
855 :    
856 :     =over 4
857 :    
858 :     =item genome
859 :    
860 :     ID of the genome whose row index is desired.
861 :    
862 :     =item RETURN
863 :    
864 :     Returns the row index for the genome with the specified ID, or an undefined
865 :     value if the genome does not participate in the subsystem.
866 :    
867 :     =back
868 :    
869 :     =cut
870 :    
871 :     sub get_genome_index {
872 :     # Get the parameters.
873 :     my ($self, $genome) = @_;
874 :     # Get the genome row index from the "genomeHash" member.
875 :     my $retVal = $self->{genomeHash}->{$genome};
876 :     return $retVal;
877 :     }
878 :    
879 :     =head3 get_cluster_number
880 :    
881 : parrello 1.12 my $number = $sub->get_cluster_number($pegID);
882 : parrello 1.1
883 :     Return the cluster number for the specified PEG, or C<-1> if the
884 :     cluster number for the PEG is unknown or it is not clustered.
885 :    
886 :     The cluster number is read into the color hash by the
887 :     L</get_pegs_from_cell> method. If the incoming PEG IDs do not
888 :     come from the most recent cell retrievals, the information returned
889 :     will be invalid. This is a serious design flaw which needs to be
890 :     fixed soon.
891 :    
892 :     =over 4
893 :    
894 :     =item pegID
895 :    
896 :     ID of the PEG whose cluster number is desired.
897 : parrello 1.4
898 :     =item RETURN
899 :    
900 :     Returns the appropriate cluster number.
901 : parrello 1.1
902 :     =back
903 :    
904 :     =cut
905 :     #: Return Type $;
906 :     sub get_cluster_number {
907 :     # Get the parameters.
908 :     my ($self, $pegID) = @_;
909 :     # Declare the return variable.
910 :     my $retVal = -1;
911 :     # Check for a cluster number in the color hash.
912 :     if (exists $self->{colorHash}->{$pegID}) {
913 :     $retVal = $self->{colorHash}->{$pegID};
914 :     }
915 :     # Return the result.
916 :     return $retVal;
917 :     }
918 :    
919 :     =head3 get_pegs_from_cell
920 :    
921 : parrello 1.12 my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
922 : parrello 1.1
923 :     Return a list of the peg IDs for the features in the specified spreadsheet cell.
924 :    
925 :     =over 4
926 :    
927 :     =item rowstr
928 :    
929 :     Genome row, specified either as a row index or a genome ID.
930 :    
931 :     =item colstr
932 :    
933 :     Role column, specified either as a column index, a role name, or a role
934 :     abbreviation.
935 :    
936 :     =item RETURN
937 :    
938 :     Returns a list of PEG IDs. The PEGs in the list belong to the genome in the
939 :     specified row and perform the role in the specified column. If the indicated
940 :     row and column does not exist, returns an empty list.
941 :    
942 :     =back
943 :    
944 :     =cut
945 :    
946 :     sub get_pegs_from_cell {
947 :     # Get the parameters.
948 :     my ($self, $rowstr, $colstr) = @_;
949 :     # Get the sprout object for accessing the database.
950 :     my $sprout = $self->{sprout};
951 :     # We need to convert the incoming row and column identifiers. We need a
952 :     # numeric column index and a character genome ID to create the ID for the
953 :     # subsystem spreadsheet cell. First, the column index: note that our version
954 :     # of "get_role_index" conveniently works for both abbreviations and full role IDs.
955 :     my $colIdx = ($colstr =~ /^(\d+)$/ ? $colstr : $self->get_role_index($colstr));
956 :     # Next the genome ID. In this case, we convert any number we find to a string.
957 :     # This requires a little care to avoid a run-time error if the row number is
958 :     # out of range.
959 :     my $genomeID = $rowstr;
960 :     if ($rowstr =~ /^(\d+)$/) {
961 :     # Here we need to convert the row number to an ID. Insure the number is in
962 :     # range. Note that if we do have a row number out of range, the genome ID
963 :     # will be invalid, and our attempt to read from the database will return an
964 :     # empty list.
965 :     my $genomeList = $self->{genomes};
966 :     if ($rowstr >= 0 && $rowstr < @{$genomeList}) {
967 :     $genomeID = $genomeList->[$rowstr]->[0];
968 :     }
969 :     }
970 :     # Construct the spreadsheet cell ID from the information we have.
971 : parrello 1.7 my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
972 : parrello 1.1 # Get the list of PEG IDs and cluster numbers for the indicated cell.
973 :     my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
974 :     [$cellID], ['ContainsFeature(to-link)',
975 :     'ContainsFeature(cluster-number)']);
976 :     # Copy the pegs into the return list, and save the cluster numbers in the color hash.
977 :     my @retVal = ();
978 :     for my $pegEntry (@pegList) {
979 :     my ($peg, $cluster) = @{$pegEntry};
980 :     $self->{colorHash}->{$peg} = $cluster;
981 :     push @retVal, $peg;
982 :     }
983 :     # Return the list. If the spreadsheet cell was empty or non-existent, we'll end
984 :     # up returning an empty list.
985 :     return @retVal;
986 :     }
987 :    
988 : parrello 1.10 =head3 get_subsetR
989 : parrello 1.8
990 : parrello 1.12 my @genomes = $sub->get_subsetR($subName);
991 : parrello 1.10
992 :     Return the genomes in the row subset indicated by the specified subset name.
993 :    
994 :     =over 4
995 :    
996 :     =item subName
997 :    
998 :     Name of the desired row subset, or C<All> to get all of the rows.
999 :    
1000 :     =item RETURN
1001 :    
1002 :     Returns a list of genome IDs corresponding to the named subset.
1003 :    
1004 :     =back
1005 :    
1006 :     =cut
1007 :    
1008 :     sub get_subsetR {
1009 :     # Get the parameters.
1010 :     my ($self, $subName) = @_;
1011 :     # Look for the specified row subset in the database. A row subset is identified using
1012 :     # the subsystem name and the subset name. The special subset "All" is actually
1013 :     # represented in the database, so we don't need to check for it.
1014 :     my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
1015 :     ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
1016 :     return @rows;
1017 :     }
1018 : parrello 1.8
1019 : parrello 1.4 =head3 get_diagrams
1020 :    
1021 : parrello 1.12 my @list = $sub->get_diagrams();
1022 : parrello 1.4
1023 :     Return a list of the diagrams associated with this subsystem. Each diagram
1024 :     is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
1025 :     page_link, img_link]> where
1026 :    
1027 :     =over 4
1028 :    
1029 :     =item diagram_id
1030 :    
1031 :     ID code for this diagram.
1032 :    
1033 :     =item diagram_name
1034 :    
1035 :     Displayable name of the diagram.
1036 :    
1037 :     =item page_link
1038 :    
1039 :     URL of an HTML page containing information about the diagram.
1040 :    
1041 :     =item img_link
1042 :    
1043 :     URL of an HTML page containing an image for the diagram.
1044 :    
1045 :     =back
1046 :    
1047 :     Note that the URLs are in fact for CGI scripts with parameters that point them
1048 :     to the correct place. Though Sprout has diagram information in it, it has
1049 :     no relationship to the diagrams displayed in SEED, so the work is done entirely
1050 :     on the SEED side.
1051 :    
1052 :     =cut
1053 :    
1054 :     sub get_diagrams {
1055 :     # Get the parameters.
1056 :     my ($self) = @_;
1057 :     # Get the diagram IDs.
1058 : parrello 1.9 my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
1059 : parrello 1.6 Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
1060 : parrello 1.4 # Create the return variable.
1061 :     my @retVal = ();
1062 :     # Loop through the diagram IDs.
1063 :     for my $diagramID (@diagramIDs) {
1064 : parrello 1.6 Trace("Processing diagram $diagramID.") if T(3);
1065 : parrello 1.9 my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
1066 :     Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
1067 : parrello 1.6 push @retVal, [$diagramID, $name, $link, $imgLink];
1068 : parrello 1.4 }
1069 : parrello 1.6 # Return the result.
1070 :     return @retVal;
1071 : parrello 1.4 }
1072 :    
1073 : parrello 1.9 =head3 get_diagram
1074 :    
1075 : parrello 1.12 my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
1076 : parrello 1.9
1077 :     Get the information (if any) for the specified diagram. The diagram corresponds
1078 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1079 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1080 :     where I<$dir> is the subsystem directory. The diagram's name is extracted from
1081 :     a tiny file containing the name, and then the links are computed using the
1082 :     subsystem name and the diagram ID. The parameters are as follows.
1083 :    
1084 :     =over 4
1085 :    
1086 :     =item id
1087 :    
1088 :     ID code for the desired diagram.
1089 :    
1090 :     =item RETURN
1091 :    
1092 :     Returns a three-element list. The first element is the diagram name, the second
1093 :     a URL for displaying information about the diagram, and the third a URL for
1094 :     displaying the diagram image.
1095 :    
1096 :     =back
1097 :    
1098 :     =cut
1099 :    
1100 :     sub get_diagram {
1101 :     my($self, $id) = @_;
1102 :     my $name = Subsystem::GetDiagramName($self->{dir}, $id);
1103 : parrello 1.11 my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
1104 : parrello 1.9 return($name, $link, $img_link);
1105 :     }
1106 :    
1107 :    
1108 :     =head3 get_diagram_html_file
1109 :    
1110 : parrello 1.12 my $fileName = $sub->get_diagram_html_file($id);
1111 : parrello 1.9
1112 :     Get the HTML file (if any) for the specified diagram. The diagram corresponds
1113 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1114 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1115 :     where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1116 :     named C<diagram.html> in the diagram directory. The parameters are as follows.
1117 :    
1118 :     =over 4
1119 :    
1120 :     =item id
1121 :    
1122 :     ID code for the desired diagram.
1123 :    
1124 :     =item RETURN
1125 :    
1126 :     Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1127 :    
1128 :     =back
1129 :    
1130 :     =cut
1131 :    
1132 :     sub get_diagram_html_file {
1133 :     my ($self, $id) = @_;
1134 :     my $retVal;
1135 :     my $ddir = "$self->{dir}/diagrams/$id";
1136 : parrello 1.20 Trace("Looking for diagram file at $ddir.") if T(3);
1137 : parrello 1.9 if (-d $ddir) {
1138 :     my $html = "$ddir/diagram.html";
1139 :     if (-f $html) {
1140 :     $retVal = $html;
1141 :     }
1142 :     }
1143 :     return $retVal;
1144 :     }
1145 :    
1146 : parrello 1.11 =head3 is_new_diagram
1147 :    
1148 : parrello 1.12 my $flag = $sub->is_new_diagram($id);
1149 : parrello 1.11
1150 :     Return TRUE if the specified diagram is in the new format, else FALSE.
1151 :    
1152 :     =over 4
1153 :    
1154 :     =item id
1155 :    
1156 :     ID code (e.g. C<d03>) of the relevant diagram.
1157 :    
1158 :     =item RETURN
1159 :    
1160 :     Returns TRUE if the diagram is in the new format, else FALSE.
1161 :    
1162 :     =back
1163 :    
1164 :     =cut
1165 :    
1166 :     sub is_new_diagram {
1167 :     my ($self, $id) = @_;
1168 :    
1169 :     my $image_map = $self->get_diagram_html_file($id);
1170 :     if ($image_map) {
1171 :     Trace("Image map found for diagram $id at $image_map.") if T(3);
1172 : parrello 1.17 Open(\*IN, "<$image_map");
1173 : parrello 1.11 my $header = <IN>;
1174 :     close(IN);
1175 : parrello 1.12
1176 : parrello 1.11 if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1177 :     return 1;
1178 :     }
1179 :     }
1180 :    
1181 :     return undef;
1182 :     }
1183 :    
1184 :     =head3 get_role_from_abbr
1185 :    
1186 : parrello 1.12 my $roleName = $sub->get_role_from_abbr($abbr);
1187 : parrello 1.11
1188 :     Return the role name corresponding to an abbreviation.
1189 :    
1190 :     =over 4
1191 :    
1192 :     =item abbr
1193 :    
1194 :     Abbreviation name of the relevant role.
1195 :    
1196 :     =item RETURN
1197 :    
1198 :     Returns the full name of the specified role.
1199 :    
1200 :     =back
1201 :    
1202 :     =cut
1203 :    
1204 :     sub get_role_from_abbr {
1205 :     # Get the parameters.
1206 :     my($self, $abbr) = @_;
1207 :     # Get the role name from the abbreviation hash.
1208 :     my $retVal = $self->{abbrHash}->{$abbr};
1209 :     # Check for a case incompatability.
1210 :     if (! defined $retVal) {
1211 :     $retVal = $self->{abbrHash}->{lcfirst $abbr};
1212 :     }
1213 :     # Return the result.
1214 :     return $retVal;
1215 :     }
1216 :    
1217 :    
1218 : parrello 1.9 =head3 get_name
1219 :    
1220 : parrello 1.12 my $name = $sub->get_name();
1221 : parrello 1.9
1222 :     Return the name of this subsystem.
1223 :    
1224 :     =cut
1225 :    
1226 :     sub get_name {
1227 :     # Get the parameters.
1228 :     my ($self) = @_;
1229 :     # Return the result.
1230 :     return $self->{name};
1231 :     }
1232 :    
1233 :     =head3 open_diagram_image
1234 :    
1235 : parrello 1.12 my ($type, $fh) = $sub->open_diagram_image($id);
1236 : parrello 1.9
1237 :     Open a diagram's image file and return the type and file handle.
1238 :    
1239 :     =over 4
1240 :    
1241 :     =item id
1242 :    
1243 :     ID of the desired diagram
1244 :    
1245 :     =item RETURN
1246 :    
1247 :     Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1248 :     for the diagram's data. If the diagram does not exist, the type will be
1249 :     returned as <undef>.
1250 :    
1251 :     =back
1252 :    
1253 :     =cut
1254 :    
1255 :     sub open_diagram_image {
1256 :     # Get the parameters.
1257 :     my ($self, $id) = @_;
1258 :     # Declare the return variables.
1259 :     my ($type, $fh);
1260 :     # Get the diagram directory.
1261 :     my $img_base = "$self->{dir}/diagrams/$id/diagram";
1262 :     # Get a list of file extensions and types.
1263 :     my %types = (png => "image/png",
1264 :     gif => "image/gif",
1265 :     jpg => "image/jpeg");
1266 :     # This is my new syntax for the for-each-while loop.
1267 :     # We loop until we run out of keys or come up with a type value.
1268 :     for my $ext (keys %types) { last if (defined $type);
1269 :     my $myType = $types{$ext};
1270 :     # Compute a file name for this diagram.
1271 :     my $file = "$img_base.$ext";
1272 :     # If it exists, try to open it.
1273 :     if (-f $file) {
1274 :     $fh = Open(undef, "<$file");
1275 :     $type = $myType;
1276 :     }
1277 :     }
1278 :     # Return the result.
1279 :     return ($type, $fh);
1280 :     }
1281 :    
1282 : parrello 1.1
1283 : parrello 1.12 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3