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

Annotation of /Sprout/SproutSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (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.21 =item rows
78 :    
79 :     Map of spreadsheet rows, keyed by genome ID. Each row is a list of cells. Each
80 :     cell is a list of feature ID.
81 :    
82 :     =item featureData
83 :    
84 :     Hash mapping feature IDs to assigned functions.
85 :    
86 : parrello 1.1 =back
87 :    
88 :     =cut
89 :    
90 :     #: Constructor SproutSubsys->new();
91 :    
92 :     =head2 Public Methods
93 :    
94 :     =head3 new
95 :    
96 : parrello 1.18 my $sub = SproutSubsys->new($subName, $sprout);
97 : parrello 1.1
98 :     Load the subsystem.
99 :    
100 :     =over 4
101 :    
102 :     =item subName
103 :    
104 :     Name of the desired subsystem.
105 :    
106 :     =item sprout
107 :    
108 :     Sprout or SFXlate object for accessing the Sprout data store.
109 :    
110 :     =back
111 :    
112 :     =cut
113 :    
114 :     sub new {
115 :     # Get the parameters.
116 :     my ($class, $subName, $sprout) = @_;
117 :     # Insure we have a Sprout object.
118 :     if (ref $sprout eq 'SFXlate') {
119 :     $sprout = $sprout->{sprout};
120 :     }
121 :     # Declare the return value.
122 :     my $retVal;
123 : parrello 1.14 # Get the subsystem's object.
124 :     my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
125 :     if (! defined $subsystemObject) {
126 :     # Here we're stuck.
127 :     Confess("Subsystem \"$subName\" not found in database.");
128 :     } else {
129 :     # We've found it, so get the major data.
130 : parrello 1.18 my ($curator, $notes, $description, $version) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
131 :     'Subsystem(description)', 'Subsystem(version)']);
132 : parrello 1.1 # Get the genome IDs and variant codes for the rows. The list returned
133 :     # by GetAll will be a list of 2-tuples, each consisting of a genome ID
134 :     # and a subsystem variant code.
135 :     my @genomes = $sprout->GetAll(['ParticipatesIn'],
136 :     'ParticipatesIn(to-link) = ? ORDER BY ParticipatesIn(variant-code), ParticipatesIn(from-link)',
137 :     [$subName], ['ParticipatesIn(from-link)',
138 :     'ParticipatesIn(variant-code)']);
139 :     # Create the genome ID directory. This is a hash that maps a genome ID to its
140 :     # row index.
141 :     my $idx = 0;
142 :     my %genomeHash = map { $_->[0] => $idx++ } @genomes;
143 :     # Get the role IDs and abbreviations. The list returned by GetAll will be
144 :     # a list of 2-tuples, each consisting of a role ID and abbreviation. The
145 :     # 2-tuples will be ordered by the spreadsheet column number.
146 : parrello 1.11 my @roles = $sprout->GetAll(['OccursInSubsystem'],
147 : parrello 1.1 'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
148 : parrello 1.18 [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)',
149 :     'OccursInSubsystem(auxiliary)']);
150 : parrello 1.19 # Now we need to create the role ID directory, which maps role IDs and their
151 :     # abbreviations to column numbers.
152 : parrello 1.1 my %roleHash = ();
153 : parrello 1.11 my %abbrHash = ();
154 : parrello 1.18 my %auxHash = ();
155 : parrello 1.1 for ($idx = 0; $idx <= $#roles; $idx++) {
156 : parrello 1.18 # Get the role ID, aux flag, and abbreviation for this column's role.
157 :     my ($roleID, $abbr, $aux) = @{$roles[$idx]};
158 :     # Put the ID and abbreviation in the role directory.
159 : parrello 1.1 $roleHash{$roleID} = $idx;
160 :     $roleHash{$abbr} = $idx;
161 : parrello 1.18 # Put the aux flag in the aux hash.
162 :     $auxHash{$roleID} = $aux;
163 : parrello 1.11 # Put the full name in the abbreviation directory.
164 :     $abbrHash{$abbr} = $roleID;
165 : parrello 1.1 }
166 : parrello 1.9 # Find the subsystem directory.
167 :     my $subDir = Subsystem::get_dir_from_name($subName);
168 :     Trace("Subsystem directory is $subDir.") if T(3);
169 : parrello 1.1 # Create the subsystem object.
170 :     $retVal = {
171 :     # Name of the subsystem. This is needed for any further database
172 :     # accesses required.
173 :     name => $subName,
174 : parrello 1.9 # Directory root for diagram and image files.
175 :     dir => $subDir,
176 : parrello 1.1 # Name of the subsystem's official curator.
177 :     curator => $curator,
178 :     # General notes about the subsystem.
179 :     notes => $notes,
180 :     # Sprout object for accessing the database.
181 :     sprout => $sprout,
182 :     # Map of genome IDs to row indices.
183 :     genomeHash => \%genomeHash,
184 :     # List of [genomeID, variantCode] tuples in row order.
185 :     genomes => \@genomes,
186 :     # Map of role IDs and abbreviations to column indices.
187 :     roleHash => \%roleHash,
188 :     # List of [roleID, abbreviation] tuples in column order.
189 :     roles => \@roles,
190 :     # Map of PEG IDs to cluster numbers.
191 :     colorHash => {},
192 : parrello 1.11 # Map of abbreviations to role names.
193 :     abbrHash => \%abbrHash,
194 : parrello 1.18 # Map of auxiliary rols.
195 :     auxHash => \%auxHash,
196 : parrello 1.2 # Map of role IDs to reactions.
197 : parrello 1.19 reactionHash => undef,
198 : parrello 1.18 # Version number.
199 :     version => $version,
200 : parrello 1.21 # Row hash, initially undefined.
201 :     rows => undef,
202 :     # Map of feature IDs to functional assignments
203 :     featureData => {},
204 : parrello 1.1 };
205 :     # Bless and return it.
206 :     bless $retVal, $class;
207 :     }
208 :     return $retVal;
209 :     }
210 :    
211 : parrello 1.18 =head3 is_aux_role
212 :    
213 :     my $flag = $sub->is_aux_role($roleID);
214 :    
215 :     Return TRUE if the specified role is auxiliary to this subsystem, FALSE
216 :     if it is essential to it.
217 :    
218 :     =over 4
219 :    
220 :     =item roleID
221 :    
222 :     ID of the relevant role.
223 :    
224 :     =item RETURN
225 :    
226 :     Returns TRUE if the specified role is auxiliary, else FALSE.
227 :    
228 :     =back
229 :    
230 :     =cut
231 :    
232 :     sub is_aux_role {
233 :     # Get the parameters.
234 :     my ($self, $roleID) = @_;
235 :     # Declare the return variable.
236 :     my $retVal = $self->{auxHash}->{$roleID};
237 :     # Return the result.
238 :     return $retVal;
239 :     }
240 :    
241 :    
242 : parrello 1.12 =head3 get_row
243 :    
244 :     my $rowData = $sub->get_row($rowIndex);
245 :    
246 :     Return the specified row in the subsystem spreadsheet. The row consists
247 :     of a list of lists. Each position in the major list represents the role
248 :     for that position, and contains a list of the IDs for the features that
249 :     perform the role.
250 :    
251 :     =over 4
252 :    
253 :     =item rowIndex
254 :    
255 :     Index of the row to return. A row contains data for a single genome.
256 :    
257 :     =item RETURN
258 :    
259 :     Returns a reference to a list of lists. Each element in the list represents
260 :     a spreadsheet column (role) and contains a list of features that perform the
261 :     role.
262 :    
263 :     =back
264 :    
265 :     =cut
266 :    
267 :     sub get_row {
268 :     # Get the parameters.
269 :     my ($self, $rowIndex) = @_;
270 :     # Get the genome ID for the specified row's genome.
271 :     my $genomeID = $self->{genomes}->[$rowIndex]->[0];
272 : parrello 1.21 # Get the row hash.
273 :     my $rowHash = $self->_get_spreadsheet();
274 :     # Declare the return variable.
275 :     my @retVal;
276 :     # If this genome does not exist for the subsystem, all the cells are empty.
277 :     if (! exists $rowHash->{$genomeID}) {
278 :     @retVal = map { [] } @{$self->{roles}};
279 :     } else {
280 :     # Here we just return the row.
281 :     push @retVal, @{$rowHash->{$genomeID}};
282 : parrello 1.12 }
283 :     # Return the result.
284 :     return \@retVal;
285 :     }
286 :    
287 : parrello 1.14 =head3 get_roles_for_genome
288 :    
289 :     my @roles = $sub->get_roles_for_genome($genome_id);
290 :    
291 :     Return a list of the roles in this subsystem that have nonempty
292 :     spreadsheet cells for the given genome.
293 :    
294 :     =over 4
295 :    
296 :     =item genome_id
297 :    
298 :     ID of the relevant genome.
299 :    
300 :     =item RETURN
301 :    
302 :     Returns a list of role IDs.
303 :    
304 :     =back
305 :    
306 :     =cut
307 :    
308 :     sub get_roles_for_genome {
309 :     # Get the parameters.
310 :     my ($self, $genome_id) = @_;
311 : parrello 1.21 # Get the subsystem's spreadsheet.
312 :     my $rowHash = $self->_get_spreadsheet();
313 :     # Declare the return variable.
314 :     my @retVal;
315 :     # Only proceed if this genome exists for this subsyste,
316 :     if (exists $rowHash->{$genome_id}) {
317 :     # Get the role list.
318 :     my $roles = $self->{roles};
319 :     # Get the row's cell list.
320 :     my $row = $rowHash->{$genome_id};
321 :     # Loop through the cells. We'll save the role name for each
322 :     # nonempty cell.
323 :     my $cols = scalar @$roles;
324 :     for (my $i = 0; $i < $cols; $i++) {
325 :     my $cell = $row->[$i];
326 :     if (scalar @$cell) {
327 :     push @retVal, $roles->[$i];
328 :     }
329 :     }
330 :     }
331 : parrello 1.14 # Return the result.
332 : parrello 1.21 return @retVal;
333 : parrello 1.14 }
334 :    
335 : parrello 1.12 =head3 get_abbr_for_role
336 :    
337 :     my $abbr = $sub->get_abbr_for_role($name);
338 :    
339 :     Get this subsystem's abbreviation for the specified role.
340 :    
341 :     =over 4
342 :    
343 :     =item name
344 :    
345 :     Name of the relevant role.
346 :    
347 :     =item RETURN
348 :    
349 :     Returns the abbreviation for the role. Each subsystem has its own abbreviation
350 :     system; the abbreviations make it easier to display the subsystem spreadsheet.
351 :    
352 :     =back
353 :    
354 :     =cut
355 :    
356 : parrello 1.14 sub get_abbr_for_role {
357 : parrello 1.12 # Get the parameters.
358 :     my ($self, $name) = @_;
359 :     # Get the index for this role.
360 :     my $idx = $self->get_role_index($name);
361 :     # Return the abbreviation.
362 :     return $self->get_role_abbr($idx);
363 :     }
364 :    
365 :     =head3 get_subsetC
366 :    
367 :     my @columns = $sub->get_subsetC($subsetName);
368 :    
369 :     Return a list of the column numbers for the columns in the named role
370 :     subset.
371 :    
372 :     =over 4
373 :    
374 :     =item subsetName
375 :    
376 :     Name of the subset whose columns are desired.
377 :    
378 :     =item RETURN
379 :    
380 :     Returns a list of the indices for the columns in the named subset.
381 :    
382 :     =back
383 :    
384 :     =cut
385 :    
386 :     sub get_subsetC {
387 :     # Get the parameters.
388 :     my ($self, $subsetName) = @_;
389 :     # Get the roles in the subset.
390 :     my @roles = $self->get_subsetC_roles($subsetName);
391 :     # Convert them to indices.
392 :     my $roleHash = $self->{roleHash};
393 :     my @retVal = map { $roleHash->{$_} } @roles;
394 :     # Return the result.
395 :     return @retVal;
396 :     }
397 :    
398 : parrello 1.1 =head3 get_genomes
399 :    
400 : parrello 1.12 my @genomeList = $sub->get_genomes();
401 : parrello 1.1
402 :     Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
403 :     in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
404 :     in the specified row.
405 :    
406 :     =cut
407 :    
408 :     sub get_genomes {
409 :     # Get the parameters.
410 :     my ($self) = @_;
411 :     # Return a list of the genome IDs. The "genomes" member contains a 2-tuple
412 :     # with the genome ID followed by the variant code. We only return the
413 :     # genome IDs.
414 :     my @retVal = map { $_->[0] } @{$self->{genomes}};
415 :     return @retVal;
416 :     }
417 :    
418 :     =head3 get_variant_code
419 :    
420 : parrello 1.12 my $code = $sub->get_variant_code($gidx);
421 : parrello 1.1
422 :     Return the variant code for the specified genome. Each subsystem has multiple
423 :     variants which involve slightly different chemical reactions, and each variant
424 :     has an associated variant code. When a genome is connected to the spreadsheet,
425 :     the subsystem variant used by the genome must be specified.
426 :    
427 :     =over 4
428 :    
429 :     =item gidx
430 :    
431 :     Row index for the genome whose variant code is desired.
432 :    
433 :     =item RETURN
434 :    
435 :     Returns the variant code for the specified genome.
436 :    
437 :     =back
438 :    
439 :     =cut
440 :    
441 :     sub get_variant_code {
442 :     # Get the parameters.
443 :     my ($self, $gidx) = @_;
444 :     # Extract the variant code for the specified row index. It is the second
445 :     # element of the tuple from the "genomes" member.
446 : parrello 1.5 my $retVal = $self->{genomes}->[$gidx]->[1];
447 : parrello 1.1 return $retVal;
448 :     }
449 :    
450 :     =head3 get_curator
451 :    
452 : parrello 1.12 my $userName = $sub->get_curator();
453 : parrello 1.1
454 :     Return the name of this subsystem's official curator.
455 :    
456 :     =cut
457 :    
458 :     sub get_curator {
459 :     # Get the parameters.
460 :     my ($self) = @_;
461 :     # Return the curator member.
462 :     return $self->{curator};
463 :     }
464 :    
465 :     =head3 get_notes
466 :    
467 : parrello 1.12 my $text = $sub->get_notes();
468 : parrello 1.1
469 :     Return the descriptive notes for this subsystem.
470 :    
471 :     =cut
472 :    
473 :     sub get_notes {
474 :     # Get the parameters.
475 :     my ($self) = @_;
476 :     # Return the notes member.
477 :     return $self->{notes};
478 :     }
479 :    
480 : parrello 1.13 =head3 get_description
481 :    
482 :     my $text = $sub->get_description();
483 :    
484 :     Return the description for this subsystem.
485 :    
486 :     =cut
487 :    
488 :     sub get_description
489 :     {
490 :     my($self) = @_;
491 :     return $self->{description};
492 :     }
493 :    
494 : parrello 1.1 =head3 get_roles
495 :    
496 : parrello 1.12 my @roles = $sub->get_roles();
497 : parrello 1.1
498 :     Return a list of the subsystem's roles. Each role corresponds to a column
499 :     in the subsystem spreadsheet. The list entry at a specified position in
500 :     the list will contain the ID of that column's role.
501 :    
502 :     =cut
503 :    
504 :     sub get_roles {
505 :     # Get the parameters.
506 :     my ($self) = @_;
507 :     # Return the list of role IDs. The role IDs are stored as the first
508 :     # element of each 2-tuple in the "roles" member.
509 :     my @retVal = map { $_->[0] } @{$self->{roles}};
510 :     return @retVal;
511 :     }
512 :    
513 :     =head3 get_reactions
514 :    
515 : parrello 1.12 my $reactHash = $sub->get_reactions();
516 : parrello 1.1
517 :     Return a reference to a hash that maps each role ID to a list of the reactions
518 :     catalyzed by the role.
519 :    
520 :     =cut
521 :    
522 :     sub get_reactions {
523 :     # Get the parameters.
524 :     my ($self) = @_;
525 : parrello 1.19 # Do we already have a reaction hash?
526 :     my $retVal = $self->{reactionHash};
527 :     if (! $retVal) {
528 :     # No, so we'll build it.
529 :     $retVal = {};
530 :     my $sprout = $self->{sprout};
531 :     for my $roleID ($self->get_roles()) {
532 :     # Get this role's reactions.
533 :     my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
534 :     [$roleID], 'Catalyzes(to-link)');
535 :     # Put them in the reaction hash.
536 :     if (@reactions > 0) {
537 :     $retVal->{$roleID} = \@reactions;
538 :     }
539 :     }
540 :     # Save it for future use.
541 :     $self->{reactionHash} = $retVal;
542 :     }
543 :     # Return the reaction hash.
544 :     return $retVal;
545 : parrello 1.1 }
546 :    
547 :     =head3 get_subset_namesC
548 :    
549 : parrello 1.12 my @subsetNames = $sub->get_subset_namesC();
550 : parrello 1.1
551 :     Return a list of the names for all the column (role) subsets. Given a subset
552 :     name, you can use the L</get_subsetC_roles> method to get the roles in the
553 :     subset.
554 :    
555 :     =cut
556 :    
557 :     sub get_subset_namesC {
558 :     # Get the parameters.
559 :     my ($self) = @_;
560 :     # Get the sprout object and use it to retrieve the subset names.
561 :     my $sprout = $self->{sprout};
562 :     my @subsets = $sprout->GetFlat(['HasRoleSubset'], 'HasRoleSubset(from-link) = ?',
563 :     [$self->{name}], 'HasRoleSubset(to-link)');
564 :     # The sprout subset names are prefixed by the subsystem name. We need to pull the
565 :     # prefix off before we return the results. The prefixing character is a colon (:),
566 :     # so we search for the last colon to get ourselves the true subset name.
567 :     my @retVal = map { $_ =~ /:([^:]+)$/; $1 } @subsets;
568 :     return @retVal;
569 :     }
570 :    
571 : parrello 1.12 =head3 get_subset_names
572 :    
573 :     my @subsetNames = $sub->get_subset_names();
574 :    
575 :     Return the names of the column subsets.
576 :    
577 :     =cut
578 :    
579 :     sub get_subset_names{
580 :     # Get the parameters.
581 :     my ($self) = @_;
582 :     # Return the result.
583 :     return $self->get_subset_namesC();
584 :     }
585 :    
586 : parrello 1.1 =head3 get_role_abbr
587 :    
588 : parrello 1.12 my $abbr = $sub->get_role_abbr($ridx);
589 : parrello 1.1
590 :     Return the abbreviation for the role in the specified column. The abbreviation
591 :     is a shortened identifier that is not necessarily unique, but is more likely to
592 :     fit in a column heading.
593 :    
594 :     =over 4
595 :    
596 :     =item ridx
597 :    
598 :     Column index for the role whose abbreviation is desired.
599 :    
600 :     =item RETURN
601 :    
602 :     Returns an abbreviated name for the role corresponding to the indexed column.
603 :    
604 :     =back
605 :    
606 :     =cut
607 :    
608 :     sub get_role_abbr {
609 :     # Get the parameters.
610 :     my ($self, $ridx) = @_;
611 :     # Return the role abbreviation. The abbreviation is the second element
612 :     # in the 2-tuple for the specified column in the "roles" member.
613 :     my $retVal = $self->{roles}->[$ridx]->[1];
614 :     return $retVal;
615 :     }
616 :    
617 : parrello 1.15
618 :     =head3 get_hope_reactions_for_genome
619 :    
620 :     my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
621 :    
622 :     This method returns a hash that maps reactions to the pegs that catalyze
623 :     them for the specified genome. For each role in the subsystem, the pegs
624 :     are computed, and these are attached to the reactions for the role.
625 :    
626 :     =over 4
627 :    
628 :     =item genome
629 :    
630 :     ID of the genome whose reactions are to be put into the hash.
631 :    
632 :     =item RETURN
633 :    
634 :     Returns a hash mapping reactions in the subsystem to pegs in the
635 : parrello 1.19 specified genome, or an empty hash if the genome is not found in the
636 : parrello 1.15 subsystem.
637 :    
638 :     =back
639 :    
640 :     =cut
641 :    
642 :     sub get_hope_reactions_for_genome {
643 : parrello 1.19 # Get the parameters.
644 : parrello 1.15 my($self, $genome) = @_;
645 : parrello 1.19 # Declare the return variable.
646 :     my %retVal;
647 :     # Look for the genome in our spreadsheet.
648 :     my $index = $self->get_genome_index($genome);
649 :     # Only proceed if we found it.
650 : parrello 1.15 if (defined $index) {
651 : parrello 1.19 # Extract the roles.
652 :     my @roles = $self->get_roles;
653 :     # Get the hope reaction hash. For each role, this gives us a list
654 :     # of reactions.
655 :     my %hope_reactions = $self->get_hope_reactions();
656 :     # Loop through the cells in this genome's role.
657 :     for my $role (@roles) {
658 :     # Get the features in this role's cell.
659 :     my @peg_list = $self->get_pegs_from_cell($genome,$role);
660 :     # Only proceed if we have hope reactions AND pegs for this role.
661 :     if (defined $hope_reactions{$role} && scalar @peg_list > 0) {
662 :     # Loop through the reactions, pushing the pegs in this cell onto
663 :     # the reaction's peg list.
664 :     for my $reaction (@{$hope_reactions{$role}}) {
665 :     push @{$retVal{$reaction}}, @peg_list;
666 :     }
667 :     }
668 :     }
669 : parrello 1.15 }
670 : parrello 1.19 # Return the result.
671 :     return %retVal;
672 : parrello 1.15 }
673 :    
674 :    
675 :     =head3 get_hope_additional_reactions
676 :    
677 :     my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
678 :    
679 :     Return a list of the additional reactions for the specified scenario.
680 :    
681 :     =over 4
682 :    
683 :     =item scenario_name
684 :    
685 :     Name of the scenario whose additional reactions are desired.
686 :    
687 :     =item RETURN
688 :    
689 :     Returns a list of the additional reactions attached to the named scenario.
690 :    
691 :     =back
692 :    
693 :     =cut
694 :    
695 : parrello 1.19 sub get_hope_additional_reactions {
696 :     # Get the parameters.
697 :     my($self, $scenario_name) = @_;
698 :     # Ask the database for this scenario's additional reactions.
699 :     my @retVal = $self->{sprout}->GetFlat(['IncludesReaction'], "IncludesReaction(from-link) = ?",
700 :     [$scenario_name], 'IncludesReaction(to-link)');
701 : parrello 1.15 return @retVal;
702 :     }
703 :    
704 :    
705 : parrello 1.12 =head3 get_hope_reactions
706 :    
707 : parrello 1.14 my %reactionHash = $subsys->get_hope_reactions();
708 : parrello 1.12
709 :     Return a hash mapping the roles of this subsystem to the EC numbers for
710 :     the reactions used in scenarios (if any). It may return an empty hash
711 :     if the Hope reactions are not yet known.
712 :    
713 :     =cut
714 :    
715 :     sub get_hope_reactions {
716 :     # Get the parameters.
717 :     my ($self) = @_;
718 :     # Try to get the hope reactions from the object.
719 :     my $retVal = $self->{hopeReactions};
720 :     if (! defined($retVal)) {
721 : parrello 1.19 # They do not exist, so we must create them. Make a copy of the role-to-reaction
722 :     # hash.
723 :     my %hopeHash = %{$self->get_reactions()};
724 : parrello 1.12 # Insure we have it if we need it again.
725 : parrello 1.19 $retVal = \%hopeHash;
726 : parrello 1.12 $self->{hopeReactions} = $retVal;
727 :     }
728 :     # Return the result.
729 : parrello 1.14 return %{$retVal};
730 : parrello 1.12 }
731 :    
732 : parrello 1.18 =head3 get_hope_reaction_notes
733 :    
734 :     my %roleHash = $sub->get_hope_reaction_notes();
735 :    
736 :     Return a hash mapping the roles of the subsystem to any existing notes
737 :     about the relevant reactions.
738 :    
739 :     =cut
740 :    
741 :     sub get_hope_reaction_notes {
742 :     # Get the parameters.
743 :     my ($self) = @_;
744 :     # Declare the return variable.
745 :     my %retVal;
746 : parrello 1.19 # Get the database object.
747 :     my $sprout = $self->{sprout};
748 :     # Get our name.
749 :     my $ssName = $self->{name};
750 :     # Loop through the roles, getting each role's hope notes.
751 :     for my $role ($self->get_roles()) {
752 :     my ($note) = $self->get_hop_reaction_note($role);
753 :     # If this role had a nonempty note, stuff it in the hash.
754 :     if ($note) {
755 :     $retVal{$role} = $note;
756 :     }
757 :     }
758 : parrello 1.18 # Return the result.
759 :     return %retVal;
760 :     }
761 :    
762 :     =head3 get_hope_reaction_note
763 :    
764 :     my $note = $sub->get_hope_reaction_note($role);
765 :    
766 :     Return the text note about the curation of the scenario reactions
767 :     relating to this role.
768 :    
769 :     =over 4
770 :    
771 :     =item role
772 :    
773 : parrello 1.19 ID of the role whose note is desired.
774 : parrello 1.18
775 :     =item RETURN
776 :    
777 : parrello 1.19 Returns the relevant role's note for this subsystem's hope reactions, or FALSE (empty string
778 :     or undefined) if no such note was found.
779 : parrello 1.18
780 :     =back
781 :    
782 :     =cut
783 :    
784 :     sub get_hope_reaction_note {
785 :     # Get the parameters.
786 :     my ($self, $role) = @_;
787 : parrello 1.19 # Ask the database for the note.
788 :     my ($retVal) = $self->{sprout}->GetFlat(['OccursInSubsystem'],
789 :     "OccursInSubsystem(from-link) = ? AND OccursInSubsystem(to-link) = ?",
790 :     [$role, $self->{name}], 'OccursInSubsystem(hope-reaction-note)');
791 : parrello 1.18 # Return the result.
792 :     return $retVal;
793 :     }
794 :    
795 : parrello 1.1 =head3 get_role_index
796 :    
797 : parrello 1.12 my $idx = $sub->get_role_index($role);
798 : parrello 1.1
799 :     Return the column index for the role with the specified ID.
800 :    
801 :     =over 4
802 :    
803 :     =item role
804 :    
805 :     ID (full name) or abbreviation of the role whose column index is desired.
806 :    
807 :     =item RETURN
808 :    
809 :     Returns the column index for the role with the specified name or abbreviation.
810 :    
811 :     =back
812 :    
813 :     =cut
814 :    
815 :     sub get_role_index {
816 :     # Get the parameters.
817 :     my ($self, $role) = @_;
818 :     # The role index is directly available from the "roleHash" member.
819 :     my $retVal = $self->{roleHash}->{$role};
820 :     return $retVal;
821 :     }
822 :    
823 :     =head3 get_subsetC_roles
824 :    
825 : parrello 1.12 my @roles = $sub->get_subsetC_roles($subname);
826 : parrello 1.1
827 :     Return the names of the roles contained in the specified role (column) subset.
828 :    
829 :     =over 4
830 :    
831 :     =item subname
832 :    
833 :     Name of the role subset whose roles are desired.
834 :    
835 :     =item RETURN
836 :    
837 :     Returns a list of the role names for the columns in the named subset.
838 :    
839 :     =back
840 :    
841 :     =cut
842 :    
843 :     sub get_subsetC_roles {
844 :     # Get the parameters.
845 :     my ($self, $subname) = @_;
846 :     # Get the sprout object. We need it to be able to get the subset data.
847 :     my $sprout = $self->{sprout};
848 :     # Convert the subset name to Sprout format. In Sprout, the subset name is
849 :     # prefixed by the subsystem name in order to get a unique subset ID.
850 :     my $subsetID = $self->{name} . ":$subname";
851 :     # Get a list of the role names for this subset.
852 :     my @roleNames = $sprout->GetFlat(['ConsistsOfRoles'], 'ConsistsOfRoles(from-link) = ?',
853 :     [$subsetID], 'ConsistsOfRoles(to-link)');
854 :     # Sort them by column number. We get the column number from the role hash.
855 :     my $roleHash = $self->{roleHash};
856 :     my @retVal = sort { $roleHash->{$a} <=> $roleHash->{$b} } @roleNames;
857 :     # Return the sorted list.
858 :     return @retVal;
859 :     }
860 :    
861 :     =head3 get_genome_index
862 :    
863 : parrello 1.12 my $idx = $sub->get_genome_index($genome);
864 : parrello 1.1
865 :     Return the row index for the genome with the specified ID.
866 :    
867 :     =over 4
868 :    
869 :     =item genome
870 :    
871 :     ID of the genome whose row index is desired.
872 :    
873 :     =item RETURN
874 :    
875 :     Returns the row index for the genome with the specified ID, or an undefined
876 :     value if the genome does not participate in the subsystem.
877 :    
878 :     =back
879 :    
880 :     =cut
881 :    
882 :     sub get_genome_index {
883 :     # Get the parameters.
884 :     my ($self, $genome) = @_;
885 :     # Get the genome row index from the "genomeHash" member.
886 :     my $retVal = $self->{genomeHash}->{$genome};
887 :     return $retVal;
888 :     }
889 :    
890 :     =head3 get_cluster_number
891 :    
892 : parrello 1.12 my $number = $sub->get_cluster_number($pegID);
893 : parrello 1.1
894 :     Return the cluster number for the specified PEG, or C<-1> if the
895 :     cluster number for the PEG is unknown or it is not clustered.
896 :    
897 :     =over 4
898 :    
899 :     =item pegID
900 :    
901 :     ID of the PEG whose cluster number is desired.
902 : parrello 1.4
903 :     =item RETURN
904 :    
905 :     Returns the appropriate cluster number.
906 : parrello 1.1
907 :     =back
908 :    
909 :     =cut
910 :     #: Return Type $;
911 :     sub get_cluster_number {
912 :     # Get the parameters.
913 :     my ($self, $pegID) = @_;
914 :     # Declare the return variable.
915 :     my $retVal = -1;
916 : parrello 1.21 # Insure we have a color hash.
917 :     $self->_get_spreadsheet();
918 : parrello 1.1 # Check for a cluster number in the color hash.
919 :     if (exists $self->{colorHash}->{$pegID}) {
920 :     $retVal = $self->{colorHash}->{$pegID};
921 :     }
922 :     # Return the result.
923 :     return $retVal;
924 :     }
925 :    
926 : parrello 1.21
927 : parrello 1.1 =head3 get_pegs_from_cell
928 :    
929 : parrello 1.12 my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
930 : parrello 1.1
931 :     Return a list of the peg IDs for the features in the specified spreadsheet cell.
932 :    
933 :     =over 4
934 :    
935 :     =item rowstr
936 :    
937 :     Genome row, specified either as a row index or a genome ID.
938 :    
939 :     =item colstr
940 :    
941 :     Role column, specified either as a column index, a role name, or a role
942 :     abbreviation.
943 :    
944 :     =item RETURN
945 :    
946 :     Returns a list of PEG IDs. The PEGs in the list belong to the genome in the
947 :     specified row and perform the role in the specified column. If the indicated
948 :     row and column does not exist, returns an empty list.
949 :    
950 :     =back
951 :    
952 :     =cut
953 :    
954 :     sub get_pegs_from_cell {
955 :     # Get the parameters.
956 :     my ($self, $rowstr, $colstr) = @_;
957 :     # Get the sprout object for accessing the database.
958 :     my $sprout = $self->{sprout};
959 :     # We need to convert the incoming row and column identifiers. We need a
960 :     # numeric column index and a character genome ID to create the ID for the
961 :     # subsystem spreadsheet cell. First, the column index: note that our version
962 :     # of "get_role_index" conveniently works for both abbreviations and full role IDs.
963 :     my $colIdx = ($colstr =~ /^(\d+)$/ ? $colstr : $self->get_role_index($colstr));
964 :     # Next the genome ID. In this case, we convert any number we find to a string.
965 :     # This requires a little care to avoid a run-time error if the row number is
966 :     # out of range.
967 :     my $genomeID = $rowstr;
968 :     if ($rowstr =~ /^(\d+)$/) {
969 :     # Here we need to convert the row number to an ID. Insure the number is in
970 :     # range. Note that if we do have a row number out of range, the genome ID
971 :     # will be invalid, and our attempt to read from the database will return an
972 :     # empty list.
973 :     my $genomeList = $self->{genomes};
974 :     if ($rowstr >= 0 && $rowstr < @{$genomeList}) {
975 :     $genomeID = $genomeList->[$rowstr]->[0];
976 :     }
977 :     }
978 : parrello 1.21 # Get the spreadsheet.
979 :     my $rowHash = $self->_get_spreadsheet();
980 :     # Delcare the return variable.
981 :     my @retVal;
982 :     # Only proceed if this genome is in this subsystem.
983 :     if (exists $rowHash->{$genomeID}) {
984 :     # Push the cell's contents into the return list.
985 :     push @retVal, @{$rowHash->{$genomeID}->[$colIdx]};
986 : parrello 1.1 }
987 :     # Return the list. If the spreadsheet cell was empty or non-existent, we'll end
988 :     # up returning an empty list.
989 :     return @retVal;
990 :     }
991 :    
992 : parrello 1.10 =head3 get_subsetR
993 : parrello 1.8
994 : parrello 1.12 my @genomes = $sub->get_subsetR($subName);
995 : parrello 1.10
996 :     Return the genomes in the row subset indicated by the specified subset name.
997 :    
998 :     =over 4
999 :    
1000 :     =item subName
1001 :    
1002 :     Name of the desired row subset, or C<All> to get all of the rows.
1003 :    
1004 :     =item RETURN
1005 :    
1006 :     Returns a list of genome IDs corresponding to the named subset.
1007 :    
1008 :     =back
1009 :    
1010 :     =cut
1011 :    
1012 :     sub get_subsetR {
1013 :     # Get the parameters.
1014 :     my ($self, $subName) = @_;
1015 :     # Look for the specified row subset in the database. A row subset is identified using
1016 :     # the subsystem name and the subset name. The special subset "All" is actually
1017 :     # represented in the database, so we don't need to check for it.
1018 :     my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
1019 :     ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
1020 :     return @rows;
1021 :     }
1022 : parrello 1.8
1023 : parrello 1.4 =head3 get_diagrams
1024 :    
1025 : parrello 1.12 my @list = $sub->get_diagrams();
1026 : parrello 1.4
1027 :     Return a list of the diagrams associated with this subsystem. Each diagram
1028 :     is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
1029 :     page_link, img_link]> where
1030 :    
1031 :     =over 4
1032 :    
1033 :     =item diagram_id
1034 :    
1035 :     ID code for this diagram.
1036 :    
1037 :     =item diagram_name
1038 :    
1039 :     Displayable name of the diagram.
1040 :    
1041 :     =item page_link
1042 :    
1043 :     URL of an HTML page containing information about the diagram.
1044 :    
1045 :     =item img_link
1046 :    
1047 :     URL of an HTML page containing an image for the diagram.
1048 :    
1049 :     =back
1050 :    
1051 :     Note that the URLs are in fact for CGI scripts with parameters that point them
1052 :     to the correct place. Though Sprout has diagram information in it, it has
1053 :     no relationship to the diagrams displayed in SEED, so the work is done entirely
1054 :     on the SEED side.
1055 :    
1056 :     =cut
1057 :    
1058 :     sub get_diagrams {
1059 :     # Get the parameters.
1060 :     my ($self) = @_;
1061 :     # Get the diagram IDs.
1062 : parrello 1.9 my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
1063 : parrello 1.6 Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
1064 : parrello 1.4 # Create the return variable.
1065 :     my @retVal = ();
1066 :     # Loop through the diagram IDs.
1067 :     for my $diagramID (@diagramIDs) {
1068 : parrello 1.6 Trace("Processing diagram $diagramID.") if T(3);
1069 : parrello 1.9 my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
1070 :     Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
1071 : parrello 1.6 push @retVal, [$diagramID, $name, $link, $imgLink];
1072 : parrello 1.4 }
1073 : parrello 1.6 # Return the result.
1074 :     return @retVal;
1075 : parrello 1.4 }
1076 :    
1077 : parrello 1.9 =head3 get_diagram
1078 :    
1079 : parrello 1.12 my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
1080 : parrello 1.9
1081 :     Get the information (if any) for the specified diagram. The diagram corresponds
1082 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1083 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1084 :     where I<$dir> is the subsystem directory. The diagram's name is extracted from
1085 :     a tiny file containing the name, and then the links are computed using the
1086 :     subsystem name and the diagram ID. The parameters are as follows.
1087 :    
1088 :     =over 4
1089 :    
1090 :     =item id
1091 :    
1092 :     ID code for the desired diagram.
1093 :    
1094 :     =item RETURN
1095 :    
1096 :     Returns a three-element list. The first element is the diagram name, the second
1097 :     a URL for displaying information about the diagram, and the third a URL for
1098 :     displaying the diagram image.
1099 :    
1100 :     =back
1101 :    
1102 :     =cut
1103 :    
1104 :     sub get_diagram {
1105 :     my($self, $id) = @_;
1106 :     my $name = Subsystem::GetDiagramName($self->{dir}, $id);
1107 : parrello 1.11 my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
1108 : parrello 1.9 return($name, $link, $img_link);
1109 :     }
1110 :    
1111 :    
1112 :     =head3 get_diagram_html_file
1113 :    
1114 : parrello 1.12 my $fileName = $sub->get_diagram_html_file($id);
1115 : parrello 1.9
1116 :     Get the HTML file (if any) for the specified diagram. The diagram corresponds
1117 :     to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1118 :     diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1119 :     where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1120 :     named C<diagram.html> in the diagram directory. The parameters are as follows.
1121 :    
1122 :     =over 4
1123 :    
1124 :     =item id
1125 :    
1126 :     ID code for the desired diagram.
1127 :    
1128 :     =item RETURN
1129 :    
1130 :     Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1131 :    
1132 :     =back
1133 :    
1134 :     =cut
1135 :    
1136 :     sub get_diagram_html_file {
1137 :     my ($self, $id) = @_;
1138 :     my $retVal;
1139 :     my $ddir = "$self->{dir}/diagrams/$id";
1140 : parrello 1.20 Trace("Looking for diagram file at $ddir.") if T(3);
1141 : parrello 1.9 if (-d $ddir) {
1142 :     my $html = "$ddir/diagram.html";
1143 :     if (-f $html) {
1144 :     $retVal = $html;
1145 :     }
1146 :     }
1147 :     return $retVal;
1148 :     }
1149 :    
1150 : parrello 1.11 =head3 is_new_diagram
1151 :    
1152 : parrello 1.12 my $flag = $sub->is_new_diagram($id);
1153 : parrello 1.11
1154 :     Return TRUE if the specified diagram is in the new format, else FALSE.
1155 :    
1156 :     =over 4
1157 :    
1158 :     =item id
1159 :    
1160 :     ID code (e.g. C<d03>) of the relevant diagram.
1161 :    
1162 :     =item RETURN
1163 :    
1164 :     Returns TRUE if the diagram is in the new format, else FALSE.
1165 :    
1166 :     =back
1167 :    
1168 :     =cut
1169 :    
1170 :     sub is_new_diagram {
1171 :     my ($self, $id) = @_;
1172 :    
1173 :     my $image_map = $self->get_diagram_html_file($id);
1174 :     if ($image_map) {
1175 :     Trace("Image map found for diagram $id at $image_map.") if T(3);
1176 : parrello 1.17 Open(\*IN, "<$image_map");
1177 : parrello 1.11 my $header = <IN>;
1178 :     close(IN);
1179 : parrello 1.12
1180 : parrello 1.11 if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1181 :     return 1;
1182 :     }
1183 :     }
1184 :    
1185 :     return undef;
1186 :     }
1187 :    
1188 :     =head3 get_role_from_abbr
1189 :    
1190 : parrello 1.12 my $roleName = $sub->get_role_from_abbr($abbr);
1191 : parrello 1.11
1192 :     Return the role name corresponding to an abbreviation.
1193 :    
1194 :     =over 4
1195 :    
1196 :     =item abbr
1197 :    
1198 :     Abbreviation name of the relevant role.
1199 :    
1200 :     =item RETURN
1201 :    
1202 :     Returns the full name of the specified role.
1203 :    
1204 :     =back
1205 :    
1206 :     =cut
1207 :    
1208 :     sub get_role_from_abbr {
1209 :     # Get the parameters.
1210 :     my($self, $abbr) = @_;
1211 :     # Get the role name from the abbreviation hash.
1212 :     my $retVal = $self->{abbrHash}->{$abbr};
1213 :     # Check for a case incompatability.
1214 :     if (! defined $retVal) {
1215 :     $retVal = $self->{abbrHash}->{lcfirst $abbr};
1216 :     }
1217 :     # Return the result.
1218 :     return $retVal;
1219 :     }
1220 :    
1221 :    
1222 : parrello 1.9 =head3 get_name
1223 :    
1224 : parrello 1.12 my $name = $sub->get_name();
1225 : parrello 1.9
1226 :     Return the name of this subsystem.
1227 :    
1228 :     =cut
1229 :    
1230 :     sub get_name {
1231 :     # Get the parameters.
1232 :     my ($self) = @_;
1233 :     # Return the result.
1234 :     return $self->{name};
1235 :     }
1236 :    
1237 :     =head3 open_diagram_image
1238 :    
1239 : parrello 1.12 my ($type, $fh) = $sub->open_diagram_image($id);
1240 : parrello 1.9
1241 :     Open a diagram's image file and return the type and file handle.
1242 :    
1243 :     =over 4
1244 :    
1245 :     =item id
1246 :    
1247 :     ID of the desired diagram
1248 :    
1249 :     =item RETURN
1250 :    
1251 :     Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1252 :     for the diagram's data. If the diagram does not exist, the type will be
1253 :     returned as <undef>.
1254 :    
1255 :     =back
1256 :    
1257 :     =cut
1258 :    
1259 :     sub open_diagram_image {
1260 :     # Get the parameters.
1261 :     my ($self, $id) = @_;
1262 :     # Declare the return variables.
1263 :     my ($type, $fh);
1264 :     # Get the diagram directory.
1265 :     my $img_base = "$self->{dir}/diagrams/$id/diagram";
1266 :     # Get a list of file extensions and types.
1267 :     my %types = (png => "image/png",
1268 :     gif => "image/gif",
1269 :     jpg => "image/jpeg");
1270 :     # This is my new syntax for the for-each-while loop.
1271 :     # We loop until we run out of keys or come up with a type value.
1272 :     for my $ext (keys %types) { last if (defined $type);
1273 :     my $myType = $types{$ext};
1274 :     # Compute a file name for this diagram.
1275 :     my $file = "$img_base.$ext";
1276 :     # If it exists, try to open it.
1277 :     if (-f $file) {
1278 :     $fh = Open(undef, "<$file");
1279 :     $type = $myType;
1280 :     }
1281 :     }
1282 :     # Return the result.
1283 :     return ($type, $fh);
1284 :     }
1285 :    
1286 : parrello 1.21 =head3 get_hope_scenario_names
1287 :    
1288 :     my @names = $sub->get_hope_scenario_names();
1289 :    
1290 :     Return a list of the names for the scenarios associated with this
1291 :     subsystem.
1292 :    
1293 :     =cut
1294 :    
1295 :     sub get_hope_scenario_names {
1296 :     # Get the parameters.
1297 :     my ($self) = @_;
1298 :     # Get the names from the database.
1299 :     my $sprout = $self->{sprout};
1300 :     my @retVal = $sprout->GetFlat("HasScenario",
1301 :     "HasScenario(from-link) = ? ORDER BY HasScenario(to-link)",
1302 :     [$self->{name}], 'to-link');
1303 :     # Return the result.
1304 :     return @retVal;
1305 :     }
1306 :    
1307 :     =head3 get_hope_input_compounds
1308 :    
1309 :     my @compounds = $sub->get_hope_input_compounds($name);
1310 :    
1311 :     Return a list of the input compounds for the named hope scenario.
1312 :    
1313 :     =over 4
1314 :    
1315 :     =item name
1316 :    
1317 :     Name of a Hope scenario attached to this subsystem.
1318 :    
1319 :     =item RETURN
1320 :    
1321 :     Returns a list of compound IDs.
1322 :    
1323 :     =back
1324 :    
1325 :     =cut
1326 :    
1327 :     sub get_hope_input_compounds {
1328 :     # Get the parameters.
1329 :     my ($self, $name) = @_;
1330 :     # Ask for the compounds.
1331 :     my @retVal = $self->{sprout}->GetFlat("IsInputFor", "IsInputFor(to-link) = ?",
1332 :     [$name], "IsInputFor(from-link)");
1333 :     # Return the result.
1334 :     return @retVal;
1335 :     }
1336 :    
1337 :     =head3 get_hope_output_compounds
1338 :    
1339 :     my ($main, $aux) = $sub->get_hope_output_compounds($name);
1340 :    
1341 :     Return a list of the output compounds for the named hope scenario.
1342 :    
1343 :     =over 4
1344 :    
1345 :     =item name
1346 :    
1347 :     Name of the relevant scenario.
1348 :    
1349 :     =item RETURN
1350 :    
1351 :     Returns two lists of compound IDs: one for the main outputs and one for the
1352 :     auxiliary outputs.
1353 :    
1354 :     =back
1355 :    
1356 :     =cut
1357 :    
1358 :     sub get_hope_output_compounds {
1359 :     # Get the parameters.
1360 :     my ($self, $name) = @_;
1361 :     # Ask for the compounds.
1362 :     my $sprout = $self->{sprout};
1363 :     my @pairs = $sprout->GetAll("IsOutputOf", "IsOutputOf(to-link) = ?",
1364 :     [$name], "from-link auxiliary");
1365 :     # We now have a list of pairs in the form [name, aux-flag]. We put each
1366 :     # name in the list indicated by its aux-flag.
1367 :     my @retVal = ([], []);
1368 :     for my $pair (@pairs) {
1369 :     push @{$retVal[$pair->[1]]}, $pair->[0];
1370 :     }
1371 :     # Return the result.
1372 :     return @retVal;
1373 :     }
1374 :    
1375 :     =head3 get_hope_map_ids
1376 :    
1377 :     my @mapIDs = $sub->get_hope_map_ids($name);
1378 :    
1379 :     Return a list of the ID numbers for the diagrams associated with the named
1380 :     scenario.
1381 :    
1382 :     =over 4
1383 :    
1384 :     =item name
1385 :    
1386 :     Name of the relevant scenario.
1387 :    
1388 :     =item RETURN
1389 :    
1390 :     Returns a list of the ID numbers for the KEGG diagrams associated with this
1391 :     scenario. These are different from the diagram IDs, all of which begin with
1392 :     the string "map". This recognizes a design incompatability between SEED and
1393 :     Sprout.
1394 :    
1395 :     =back
1396 :    
1397 :     =cut
1398 :    
1399 :     sub get_hope_map_ids {
1400 :     # Get the parameters.
1401 :     my ($self, $name) = @_;
1402 :     # Get the map IDs.
1403 :     my @diagrams = $self->{sprout}->GetFlat('IsOnDiagram', "IsOnDiagram(from-link) = ?",
1404 :     [$name], 'to-link');
1405 :     # Modify and return the result.
1406 :     my @retVal = map { /(\d+)/ } @diagrams;
1407 :     return @retVal;
1408 :     }
1409 :    
1410 :     =head3 all_functions
1411 :    
1412 :     my $pegRoles = $sub->all_functions();
1413 :    
1414 :     Return a hash of all the features in the subsystem. The hash maps each
1415 :     feature ID to its functional assignment.
1416 :    
1417 :     =cut
1418 :    
1419 :     sub all_functions {
1420 :     # Get the parameters.
1421 :     my ($self) = @_;
1422 :     # Insure we have a spreadsheet.
1423 :     $self->_get_spreadsheet();
1424 :     # Return the feature hash.
1425 :     return $self->{featureData};
1426 :     }
1427 :    
1428 :     =head2 Internal Utility Methods
1429 :    
1430 :     =head3 _get_spreadsheet
1431 :    
1432 :     my $hash = $sub->_get_spreadsheet();
1433 :    
1434 :     Return a reference to a hash mapping each of the subsystem's genomes to
1435 :     their spreadsheet rows. Each row is a list of cells, and each cell is a
1436 :     list of feature IDs. This method also creates the color hash that maps PEGs
1437 :     to cluster numbers.
1438 :    
1439 :     =cut
1440 :    
1441 :     sub _get_spreadsheet {
1442 :     # Get the parameters.
1443 :     my ($self) = @_;
1444 :     # Do we already have a spreadsheet?
1445 :     my $retVal = $self->{rows};
1446 :     if (! defined $retVal) {
1447 :     # We don't, so we have to create one. Start with an empty hash.
1448 :     $retVal = {};
1449 :     # Ask for all the subsystem's cells and their features.
1450 :     my $query = $self->{sprout}->Get("HasSSCell SSCell ContainsFeature Feature",
1451 :     "HasSSCell(from-link) = ?",
1452 :     [$self->{name}]);
1453 :     # Loop through the features.
1454 :     while (my $feature = $query->Fetch()) {
1455 :     # Get the column number, the feature ID, and the cluster number.
1456 :     my $featureID = $feature->PrimaryValue('ContainsFeature(to-link)');
1457 :     my $cluster = $feature->PrimaryValue('ContainsFeature(cluster-number)');
1458 :     my $column = $feature->PrimaryValue('SSCell(column-number)');
1459 :     my $role = $feature->PrimaryValue('Feature(assignment)');
1460 :     # Compute the genome.
1461 :     my $genomeID = FIG::genome_of($featureID);
1462 :     # If we don't have this genome in the hash, create it.
1463 :     if (! exists $retVal->{$genomeID}) {
1464 :     # The initial value is a list of empty lists. Features
1465 :     # are then pushed into each individual list.
1466 :     my @row = map { [] } @{$self->{roles}};
1467 :     # Put this list of null lists in the hash.
1468 :     $retVal->{$genomeID} = \@row;
1469 :     }
1470 :     # Get this row. We know now that it exists.
1471 :     my $row = $retVal->{$genomeID};
1472 :     # Add this feature to the appropriate cell in the row.
1473 :     push @{$row->[$column]}, $featureID;
1474 :     # Put it in the color hash and the feature data hash.
1475 :     $self->{colorHash}->{$featureID} = $cluster;
1476 :     $self->{featureData}->{$featureID} = $role;
1477 :     }
1478 :     # Save the row hash.
1479 :     $self->{rows} = $retVal;
1480 :     }
1481 :     # Return the result.
1482 :     return $retVal;
1483 :     }
1484 :    
1485 :     =head3 get_col
1486 :    
1487 :     my $cellArray = $sub->get_col($idx);
1488 :    
1489 :     Return an array of the cells in the specified column of the subsystem
1490 :     spreadsheet. Each cell is a reference to a list of the features for the
1491 :     corresponding row in the specified column.
1492 :    
1493 :     =over 4
1494 :    
1495 :     =item idx
1496 :    
1497 :     Index of the desired column.
1498 :    
1499 :     =item RETURN
1500 :    
1501 :     Returns a reference to a list containing the spreadsheet column's cells, in
1502 :     row order.
1503 :    
1504 :     =back
1505 :    
1506 :     =cut
1507 :    
1508 :     sub get_col {
1509 :     # Get the parameters.
1510 :     my ($self, $idx) = @_;
1511 :     # Declare the return variable.
1512 :     my @retVal;
1513 :     # Get the subsystem spreadsheet.
1514 :     my $sheet = $self->_get_spreadsheet();
1515 :     # Loop through the row list.
1516 :     for my $rowPair (@{$self->{genomes}}) {
1517 :     # Get the genome for this row. Each row pair is [genomeID, variantCode].
1518 :     my ($genomeID) = @$rowPair;
1519 :     # Get the genome's row in the spreadsheet.
1520 :     my $rowList = $sheet->{$genomeID};
1521 :     # Push this column's cell into the output list.
1522 :     push @retVal, $rowList->[$idx];
1523 :     }
1524 :     # Return the result.
1525 :     return \@retVal;
1526 :     }
1527 : parrello 1.1
1528 : parrello 1.12 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3