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

Annotation of /FigWebServices/subsys_summary.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.25 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3