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

Annotation of /Sprout/SaplingSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3