[Bio] / FigWebServices / subsys_summary.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/subsys_summary.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

1 : redwards 1.1
2 :     =pod
3 :    
4 :     =head1
5 :    
6 :     Create a summary of subsystems
7 :    
8 :     =cut
9 :    
10 :     use strict;
11 :     use FIG;
12 :     use HTML;
13 :     use raelib;
14 :     use CGI;
15 :     my $cgi=new CGI;
16 :    
17 :    
18 :     my $fig;
19 :     eval {
20 :     $fig = new FIG;
21 :     };
22 :    
23 :     if ($@ ne "")
24 :     {
25 :     my $err = $@;
26 :    
27 :     my(@html);
28 :    
29 :     push(@html, $cgi->p("Error connecting to SEED database."));
30 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
31 :     {
32 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
33 :     }
34 :     else
35 :     {
36 :     push(@html, $cgi->pre($err));
37 :     }
38 :     &HTML::show_page($cgi, \@html, 1);
39 :     exit;
40 :     }
41 :    
42 :    
43 :    
44 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
45 :    
46 :     my $html = [];
47 :    
48 :    
49 :     if ($cgi->param('submit') eq "Summarize Subsystems")
50 :     {
51 :     summarize_ss();
52 :     }
53 :     else
54 :     {
55 :     show_initial();
56 :     }
57 :    
58 :     unshift @$html, "<TITLE>The SEED - Subsystem summarizer </TITLE>\n";
59 :     &HTML::show_page($cgi, $html, 1);
60 :     exit;
61 :    
62 :    
63 :    
64 :    
65 :    
66 :    
67 :    
68 :    
69 :    
70 :    
71 :     sub summarize_ss {
72 :     my @wants;
73 :     foreach my $w ($cgi->param('korgs')) {
74 :     $w =~ /\((\d+\.\d+)\)/;
75 :     push @wants, $1;
76 :     }
77 :    
78 :    
79 : redwards 1.5 my @wantheaders;
80 :     foreach my $gen (@wants) {push @wantheaders, $fig->abbrev($fig->genus_species($gen))}
81 :    
82 : redwards 1.1 my @th;
83 : redwards 1.2 if ($cgi->param('levels')) {push @th, ('Level 1', 'Level 2')}
84 :     push @th, 'Subsystem'; # we should have this, at least
85 :     if ($cgi->param('genomes')) {push @th, ('Organisms')}
86 : redwards 1.5 if ($cgi->param('stats')) {push @th, ('Roles', 'Total Pegs', @wantheaders)}
87 :     elsif ($cgi->param('korgs')) {push @th, ('Roles', @wantheaders)}
88 : redwards 1.1
89 :     my $tableheader="<tr><th>". (join "</th><th>", @th) . "</th></tr>\n\n";
90 :    
91 :     my $cols=scalar @th;
92 :     my $table;
93 :     foreach my $subsys ($fig->all_subsystems) {
94 :    
95 :     # figure out how many roles we have, as this will determine the number of rows in the table
96 :     my @roles=$fig->subsystem_to_roles($subsys);
97 :     my $rows=1;
98 : redwards 1.3 if (!$cgi->param('stats') && $cgi->param('korgs')) {$rows=scalar @roles}
99 : redwards 1.1
100 :     # figure out which genomes are in this subsystem
101 :     my %genomes;
102 :     foreach my $gen (@{$fig->subsystem_genomes($subsys)}) {$genomes{$gen->[0]}=$gen->[1]}
103 :    
104 : redwards 1.2 # start a new row for this data
105 : redwards 1.3 # tablerows is a refence to an array.
106 : redwards 1.4 # each element is an array of tablecells with the following values value colspan rowspan width
107 :     # if colspan or rowspan are undef they are believed to be 1
108 :     # if width is ommitted it is ignored
109 :    
110 : redwards 1.3 my $tablerows;
111 : redwards 1.7 my $mt; #DELETE THIS
112 : redwards 1.1 # get the classification if required
113 :     if ($cgi->param('levels')) {
114 : redwards 1.2 # get the classification and make sure there are now 2 columns as andrei doesn't like #3.
115 : redwards 1.1 my $class=$fig->subsystem_classification($subsys);
116 : redwards 1.2 unless ($class) {@$class=(' &nbsp; ',' &nbsp; ')}
117 :     unless ($$class[0]) {$$class[0] = " &nbsp; "}
118 :     unless ($$class[1]) {$$class[1] = " &nbsp; "}
119 :     # remove anything more than $$class[1];
120 :     @$class=($$class[0], $$class[1]); # could have done this with splice. Ech.
121 :    
122 : redwards 1.3 foreach my $c (@$class) {
123 : redwards 1.5 push @$tablerows, [$c, 1, $rows, 20];
124 : redwards 1.3 }
125 : redwards 1.1 }
126 :    
127 : redwards 1.2 # add the subsystem to the table
128 : redwards 1.4 push @$tablerows, ["<strong>$subsys<strong>", '1', $rows];
129 : redwards 1.2
130 : redwards 1.1 # add the genomes in the subsystem
131 : redwards 1.4 if ($cgi->param('genomes') && $cgi->param('stats')) {push @$tablerows, [(scalar keys %genomes), '1', $rows]}
132 : redwards 1.3 elsif ($cgi->param('genomes')) {
133 :     my $c=join "<br>\n", sort {$a cmp $b} values %genomes;
134 : redwards 1.4 push @$tablerows, [$c, 1, $rows];
135 : redwards 1.3 }
136 : redwards 1.2
137 : redwards 1.3 #
138 :     # This is convolvuted because we may want to skip some empty cells, but we won't know whether
139 :     # we want to skip them. Also, we are using rowspan/colspan to determine the size of the cells
140 :     # so we need everything defined
141 :     #
142 :     # I store the table initially in @$tablerows, and then push it into @$table. Later on we
143 :     # reconstruct @$table with <td> etc....
144 :     #
145 :     # Now I am going to store the rows in @$toadd, and if we want them I will add them to @$table.
146 :     #
147 :     # For stats, there is only one row in @$toadd, but for other data there are several because
148 :     # of the use of rowspan
149 :    
150 :     my $pegcount;
151 :     my $toadd; #this is what we will add if we need to
152 : redwards 1.2 if ($cgi->param('stats')) {
153 : redwards 1.4 push @$tablerows, [(scalar @roles), '1', $rows];
154 : redwards 1.3 my $totalpegs;
155 : redwards 1.2 # there should be a quicker way of getting this ... ?
156 :     foreach my $role (@roles) {
157 :     foreach my $genome (keys %genomes) {
158 :     my $count = scalar ($fig->pegs_in_subsystem_cell($subsys, $genome, $role));
159 :     $pegcount->{$genome} += $count;
160 :     $totalpegs += $count;
161 :     }
162 :     }
163 : redwards 1.3
164 : redwards 1.4 push @$tablerows, [$totalpegs, '1', $rows];
165 : redwards 1.2 foreach my $w (@wants) {
166 : redwards 1.4 push @$tablerows, [$pegcount->{$w}, '1', $rows]; # pegs for each of the chosen genomes
167 : redwards 1.2 }
168 : redwards 1.3 push @$toadd, $tablerows;
169 : redwards 1.2 }
170 : redwards 1.3 elsif ($cgi->param('korgs')) {
171 : redwards 1.1 my $first=1;
172 :     foreach my $role (@roles) {
173 :     my $genomeroles;
174 :     foreach my $gen (@wants) {
175 : redwards 1.2 my $cell = ' &nbsp; ';
176 : redwards 1.1 if ($genomes{$gen}) {
177 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys, $gen, $role)) {
178 : redwards 1.6 $cell .= &HTML::fid_link($cgi,$peg, 'local') . "; ";
179 : redwards 1.1 }
180 :     }
181 : redwards 1.4 push @$genomeroles, [$cell, 1, 1];
182 : redwards 1.1 }
183 :     # because I am using rowspan to make long columns, we don't want the tr on the first of these.
184 : redwards 1.3 if ($first) {
185 : redwards 1.7 push @$tablerows, [$role, 1, 1], @$genomeroles;
186 : redwards 1.4 push @$toadd, @$tablerows;
187 :     undef $first;
188 : redwards 1.3 }
189 :     else {
190 : redwards 1.4 my @tr=([$role, 1, 1], @$genomeroles);
191 : redwards 1.7 push @$toadd, @tr;
192 : redwards 1.3 }
193 : redwards 1.1 }
194 :     }
195 : redwards 1.5
196 :     unless ($toadd) {
197 :     push @$toadd, @$tablerows;
198 :     } # in case we didn't define it
199 :    
200 :    
201 : redwards 1.3 # now decide if we want the table
202 :     if ($cgi->param('orgpegs')) {
203 :     my $mustadd;
204 :     foreach my $org (@wants) {if ($pegcount->{$org}) {$mustadd=1}} # we'll add it if one of the orgs has a role
205 : redwards 1.7 if ($mustadd) {push @$table, $toadd}
206 : redwards 1.3 }
207 :     elsif ($cgi->param("haveroles")) {
208 : redwards 1.7 if (scalar(@roles)) {push @$table, $toadd}
209 : redwards 1.3 }
210 :     else {
211 : redwards 1.7 push @$table, $toadd;
212 : redwards 1.3 }
213 :     }
214 :    
215 :     # now convert $table into a table
216 : redwards 1.4
217 :     # sort the table
218 :     # if we have levels we want to sort on level 1 and then level 2 and then subsysname
219 :     # if not, we just sort on subsys name
220 :     if ($cgi->param("levels")) {
221 :     @$table = sort {
222 :     $a->[0]->[0] cmp $b->[0]->[0]
223 :     ||
224 :     $a->[1]->[0] cmp $b->[1]->[0]
225 :     ||
226 :     $a->[2]->[0] cmp $b->[2]->[0]
227 :     } @$table;
228 :     }
229 :     else {
230 :     @$table = sort {
231 :     $a->[0]->[0] cmp $b->[0]->[0]
232 :     } @$table;
233 :     }
234 :    
235 :    
236 : redwards 1.3 my $tab;
237 :     foreach my $row (@$table) {
238 :     $tab .= "\n<tr>";
239 :     foreach my $cell (@$row) {
240 : redwards 1.4 unless (ref($cell) eq "ARRAY") {
241 :     print STDERR "Didn't work. This is what we have for the row: ", join "\n", @$row, "\n";
242 :     exit(-1);
243 :     }
244 : redwards 1.5 my $width='';
245 : redwards 1.6 if ($cell->[3]) {$width="width=" . $cell->[3]}
246 : redwards 1.5 $tab .= "\n\t<td valign=top $width colspan=$cell->[1] rowspan=$cell->[2]>$cell->[0]</td>";
247 : redwards 1.3 }
248 :     $tab .= "\n</tr>\n";
249 : redwards 1.1 }
250 : redwards 1.3
251 :     push @$html, ("\n<table border=1>" . $tableheader . $tab . "</table>\n");
252 : redwards 1.1 }
253 :    
254 :    
255 :    
256 :    
257 :    
258 :    
259 :    
260 :    
261 :    
262 :    
263 :     sub show_initial {
264 :     #############
265 :     #
266 :     # Stolen from index.cgi
267 :     #
268 :     #
269 :    
270 :     my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' );
271 :    
272 :     #
273 :     # Canonical names must match the keywords used in the DBMS. They are
274 :     # defined in compute_genome_counts.pl
275 :     #
276 :     my %canonical = (
277 :     'All' => undef,
278 :     'Archaea' => 'Archaea',
279 :     'Bacteria' => 'Bacteria',
280 :     'Eucarya' => 'Eukaryota',
281 :     'Viruses' => 'Virus',
282 :     'Environmental samples' => 'Environmental Sample'
283 :     );
284 :    
285 :     my $req_dom = $cgi->param( 'domain' ) || 'All';
286 :     my @domains = $cgi->radio_group( -name => 'domain',
287 :     -default => $req_dom,
288 :     -override => 1,
289 :     -values => [ @display ]
290 :     );
291 :    
292 :     my $n_domain = 0;
293 :     my %dom_num = map { ( $_, $n_domain++ ) } @display;
294 :     my $req_dom_num = $dom_num{ $req_dom } || 0;
295 :    
296 :     #
297 :     # Viruses and Environmental samples must have completeness = All (that is
298 :     # how they are in the database). Otherwise, default is Only "complete".
299 :     #
300 :     my $req_comp = ( $req_dom_num > $dom_num{ 'Eucarya' } ) ? 'All'
301 :     : $cgi->param( 'complete' ) || 'Only "complete"';
302 :     my @complete = $cgi->radio_group( -name => 'complete',
303 :     -default => $req_comp,
304 :     -override => 1,
305 :     -values => [ 'All', 'Only "complete"' ]
306 :     );
307 :     #
308 :     # Use $fig->genomes( complete, restricted, domain ) to get org list:
309 :     #
310 :     my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";
311 :    
312 :     my @orgs = sort map { my $org = $_; my $gs = $fig->genus_species($org); my $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }
313 :     $fig->genomes( $complete, undef, $canonical{ $req_dom } );
314 :    
315 :     my $n_genomes = @orgs;
316 :    
317 :     push @$html, $cgi->start_form,
318 :     $cgi->h2("Please choose one or more organisms from the list below to see in the subsystems table"),
319 :     "<TABLE>\n",
320 :     " <TR>\n",
321 :     " <TD>",
322 :     $cgi->scrolling_list( -name => 'korgs',
323 :     -size => 10,
324 :     -multiple => 1,
325 :     -values => \@orgs,
326 :     ),
327 :     $cgi->br,
328 :     "$n_genomes genomes shown ",
329 :     $cgi->submit( 'Update List' ), $cgi->reset, $cgi->submit('submit', 'Summarize Subsystems'),
330 :     "</TD>",
331 :     " <TD>",
332 :     join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n",
333 :     join( "<br>", "<b>Completeness?</b>", @complete), "\n",
334 :     "</TD>",
335 :     " </TR>\n",
336 :     "</TABLE>\n",
337 :     $cgi->p,
338 : redwards 1.2 $cgi->checkbox(-name=>"stats", -label=>"Only show statistics", -checked=>'on'), $cgi->p,
339 : redwards 1.1 $cgi->checkbox(-name=>"levels", -label=>"Show subsystem classification", -checked=>'on'), $cgi->p,
340 :     $cgi->checkbox(-name=>"genomes", -label=>"Show genomes in subsystem", -checked=>'on'), $cgi->p,
341 : redwards 1.4 $cgi->checkbox(-name=>"haveroles", -label=>"Show only subsystems that have roles defined"), $cgi->p,
342 :     $cgi->checkbox(-name=>"orgpegs", -label=>"Show only subsystems that have roles in the organism(s) you have chosen"), $cgi->p,
343 : redwards 1.3
344 : redwards 1.1 $cgi->end_form,
345 :    
346 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3