Annotation of /Sprout/SproutSubsys.pm

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

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

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3