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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3