[Bio] / FigKernelPackages / UnvSubsys.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/UnvSubsys.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : overbeek 1.1 package UnvSubsys;
2 :    
3 : overbeek 1.2 use Subsystem;
4 : overbeek 1.1 use Carp;
5 :     use FIG;
6 :    
7 :     use Data::Dumper;
8 :     use strict;
9 :    
10 :     sub new
11 :     {
12 :     my($class, $ssa, $fig, $colors, $aliases) = @_;
13 :    
14 :     $ssa =~ s/ /_/g;
15 :    
16 :    
17 : overbeek 1.2 ### { Roles =>Roles,
18 :     ### RoleIndex => ToRoleIndexHash,
19 :     ### RoleSubsets => ColSubsets,
20 :     ### Genomes => Genomes,
21 :     ### GenomeIndex => ToGenomeIndexHash,
22 :     ### PegHash => PegHash,
23 :     ### Colors => ColorHash,
24 :     ### Aliases => AliasHash,
25 :     ### Curator => Curator,
26 :     ### Notes => Notes,
27 :     ### Reactions => ReactionHash
28 :     ### }
29 : overbeek 1.1 ###
30 :     ### Roles = pointer to a list of [Role,Abbrev,[ReactionURLs]]
31 :     ###
32 :     ### ToRoleIndexHash = a pointer to a hash: key=Role Value=RoleIndex
33 :     ###
34 :     ### ColSubsets = pointer to a list of [SubsetName,[RoleIndexesFrom0]]
35 :     ###
36 :     ### Genomes is a pointer to a list of [Genome,Variant]
37 :     ###
38 :     ### ToGenomeIndexHash = a pointer to a hash: key=Genome value=GenomeIndex
39 :     ###
40 :     ### PegHash = a pointer to a hash of hashes such that $peg_hash->{$genome_index}->{$role_index} = a
41 :     ### pointer to a list of PEGs
42 :     ###
43 :     ### ColorHash is a hash: key=PEG value=color
44 :     ###
45 :     ### AliasHash is a hash: key=PEG value=aliases
46 :     ###
47 : overbeek 1.2 ### ReactionHash is a hash: key=Role value=[reaction-ids]
48 : overbeek 1.1
49 :     if (ref($fig) eq "FIG")
50 :     {
51 : overbeek 1.2
52 :    
53 : overbeek 1.1 my $subsystem = new Subsystem($ssa,$fig,0);
54 : overbeek 1.2 my $curator = $subsystem->get_curator;
55 :     my $notes = $subsystem->get_notes;
56 :     $notes =~ s/ /\n/g;
57 : overbeek 1.1 my @roles = $subsystem->get_roles;
58 :     my $reactions = $subsystem->get_reactions;
59 :     my @genomes = $subsystem->get_genomes;
60 :     my @col_subsets = $subsystem->get_subset_namesC;
61 :    
62 :     my $role_info = [];
63 :     my $roleH = {};
64 :    
65 :     my($i,$j,$subset,$peg);
66 :     for ($i=0; ($i < @roles); $i++)
67 :     {
68 :     my $role = $roles[$i];
69 :     my $abbrev = $subsystem->get_role_abbr( $subsystem->get_role_index( $role ) );
70 :     my $react = $reactions ? join(",", map { &HTML::reaction_link($_) } @{$reactions->{$role}}) : [];
71 :     push(@$role_info,[$role,$abbrev,$react]);
72 :     $roleH->{$role} = $i;
73 :     }
74 :    
75 :     my $subset_info = [];
76 :     foreach $subset (@col_subsets)
77 :     {
78 :     if ($subset ne 'All')
79 :     {
80 : overbeek 1.2 push(@$subset_info,[$subset,[map { $roleH->{$_} } $subsystem->get_subsetC_roles($subset)]]);
81 : overbeek 1.1 }
82 :     }
83 :    
84 :     my $genomes_info = [];
85 :     my $genomeH = {};
86 :     for ($i=0; ($i < @genomes); $i++)
87 :     {
88 :     my $genome = $genomes[$i];
89 :     my $variant = $subsystem->get_variant_code( $subsystem->get_genome_index( $genome ) );
90 :     push(@$genomes_info,[$genome,$variant]);
91 :     $genomeH->{$genome} = $i;
92 :     }
93 :    
94 :     my $pegH = {};
95 :     for ($i=0; ($i < @genomes); $i++)
96 :     {
97 :     my $genome = $genomes[$i];
98 :     for ($j=0; ($j < @roles); $j++)
99 :     {
100 :     my $role = $roles[$j];
101 :     my @pegs = $subsystem->get_pegs_from_cell($genome,$role);
102 :     $pegH->{$i}->{$j} = [@pegs];
103 :     }
104 :     }
105 :    
106 :     my $colorsH = $colors ? &set_colors($fig,$pegH) : {};
107 :     my $aliasesH = $aliases ? &set_aliases($fig,$pegH) : {};
108 : overbeek 1.2 my $reactions = $subsystem->get_reactions;
109 :     my $self = { Roles => $role_info,
110 :     RoleIndex => $roleH,
111 :     RoleSubsets => $subset_info,
112 :     Genomes => $genomes_info,
113 : overbeek 1.3 GenomeIndex => $genomeH,
114 : overbeek 1.2 PegHash => $pegH,
115 :     Colors => $colorsH,
116 :     Aliases => $aliasesH,
117 :     Curator => $curator,
118 :     Notes => $notes,
119 :     Reactions => $reactions
120 :     };
121 : overbeek 1.1 bless($self, $class);
122 :     return $self;
123 :     }
124 :     else
125 :     {
126 :     return undef;
127 :     }
128 :     }
129 :    
130 : overbeek 1.2 sub subsystem_curator {
131 :     my($self) = @_;
132 :    
133 :     my $curator = $self->{Curator};
134 :     $curator =~ s/master://;
135 :     return $curator;
136 :     }
137 :    
138 :     sub get_roles {
139 :     my($self) = @_;
140 :    
141 :     return map { $_->[0] } @{$self->{Roles}};
142 :     }
143 :    
144 : overbeek 1.3 sub get_genome_index {
145 :     my($self,$genome) = @_;
146 :    
147 :     return $self->{GenomeIndex}->{$genome};
148 :     }
149 :    
150 :     sub get_genomes {
151 :     my($self) = @_;
152 :    
153 :     return map { $_->[0] } @{$self->{Genomes}};
154 :     }
155 :    
156 :     sub get_variant_code {
157 :     my($self,$genome) = @_;
158 :    
159 :     if ($genome =~ /^\d+$/)
160 :     {
161 :     return $self->{Genomes}->[$genome]->[1];
162 :     }
163 :     else
164 :     {
165 :     my $genomeI = $self->{GenomeIndex}->{$genome};
166 :     return $self->{Genomes}->[$genomeI]->[1];
167 :     }
168 :     }
169 :    
170 :     sub get_pegs_from_cell {
171 :     my($self,$genome,$role) = @_;
172 :    
173 :     my $genomeI = $self->{GenomeIndex}->{$genome};
174 :     my $roleI = $self->{RoleIndex}->{$role};
175 :    
176 :     my $pegs = $self->{PegHash}->{$genomeI}->{$roleI};
177 :     return $pegs ? @$pegs : ();
178 :     }
179 :    
180 :     sub get_notes {
181 :     my($self) = @_;
182 :    
183 :     return $self->{Notes};
184 :     }
185 :    
186 : overbeek 1.2 sub get_role_index {
187 :     my($self,$role) = @_;
188 :    
189 :     return $self->{RoleIndex}->{$role};
190 :     }
191 :    
192 :     sub get_role_abbr {
193 :     my($self,$roleI) = @_;
194 :    
195 :     if ($roleI !~ /^\d+$/)
196 :     {
197 :     $roleI = $self->{RoleIndex}->{$roleI};
198 :     }
199 :     my $roles = $self->{Roles};
200 :     return $roles->[$roleI]->[1];
201 :     }
202 :    
203 :     sub get_reactions {
204 :     my($self) = @_;
205 :    
206 :     return $self->{Reactions};
207 :     }
208 :    
209 :     sub get_subset_namesC {
210 :     my($self) = @_;
211 :    
212 :     return map { $_->[0] } @{$self->{RoleSubsets}};
213 :     }
214 :    
215 :     sub get_subsetC_roles {
216 :     my($self,$subset) = @_;
217 :     my($i,$j);
218 :    
219 :     my $subset_info = $self->{RoleSubsets};
220 :     for ($i=0; ($i < @$subset_info) && ($subset_info->[$i]->[0] ne $subset); $i++) {}
221 :     if ($i < @$subset_info)
222 :     {
223 :     my @roles = ();
224 :     foreach $j (@{$subset_info->[$i]->[1]})
225 :     {
226 :     push(@roles,$self->{Roles}->[$j]->[0]);
227 :     }
228 :     return @roles;
229 :     }
230 :     return undef;
231 :     }
232 :    
233 : overbeek 1.1 1;
234 :    
235 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3