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

Annotation of /Sprout/SaplingSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3