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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (view) (download)

1 : redwards 1.10 # -*- perl -*-
2 : overbeek 1.1 #### start ####
3 : overbeek 1.5
4 : overbeek 1.1 use FIG;
5 :     my $fig = new FIG;
6 :    
7 :     use HTML;
8 :     use strict;
9 :     use CGI;
10 :     my $cgi = new CGI;
11 :    
12 : overbeek 1.2 if (0)
13 : overbeek 1.1 {
14 :     my $VAR1;
15 :     eval(join("",`cat /tmp/statistics_parms`));
16 :     $cgi = $VAR1;
17 :     # print STDERR &Dumper($cgi);
18 :     }
19 :    
20 :     if (0)
21 :     {
22 :     print $cgi->header;
23 :     my @params = $cgi->param;
24 :     print "<pre>\n";
25 :     foreach $_ (@params)
26 :     {
27 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
28 :     }
29 :    
30 :     if (0)
31 :     {
32 :     if (open(TMP,">/tmp/statistics_parms"))
33 :     {
34 :     print TMP &Dumper($cgi);
35 :     close(TMP);
36 :     }
37 :     }
38 :     exit;
39 :     }
40 :    
41 :     my $html = [];
42 : olson 1.7 unshift @$html, "<TITLE>The SEED Statistics Page</TITLE>\n";
43 : overbeek 1.1
44 : overbeek 1.8 my @genomes = $cgi->param('genome');
45 :     my $request = $cgi->param('request');
46 : overbeek 1.9
47 :     if ($request eq "subsystems_summary")
48 :     {
49 :     &subsys_summary($fig,$cgi,$html);
50 :     }
51 : redwards 1.10 elsif ($request eq "edit_kv_stats") {
52 :     &edit_kv_stats($fig,$cgi,$html, $cgi->param('genome'));
53 :     }
54 : overbeek 1.9 elsif ((@genomes == 0) && (! $request))
55 : overbeek 1.8 {
56 :     &table_of_genomes($fig,$cgi,$html);
57 :     }
58 :     elsif (! $request)
59 :     {
60 :     my $genome;
61 :     foreach $genome (@genomes)
62 :     {
63 :     &basic_stats($fig,$cgi,$html,$genome);
64 :     push(@$html,$cgi->hr);
65 :     &assignment_stats($fig,$cgi,$html,$genome);
66 :     push(@$html,$cgi->hr);
67 : redwards 1.10 &kv_stats($fig, $cgi, $html, $genome);
68 : overbeek 1.8 my $user = $cgi->param('user');
69 :     push(@$html,"<a href=./genome_statistics.cgi?genome=$genome&request=show_subsystems&user=$user>Show Subsystems</a>");
70 :     push(@$html,$cgi->br);
71 :     }
72 :     }
73 :     elsif (@genomes == 0)
74 : overbeek 1.1 {
75 : olson 1.7 unshift @$html, "<TITLE>The SEED Statistics Page</TITLE>\n";
76 : overbeek 1.8 push(@$html,"<h1>Sorry, you need to specify at least one valid genome</h1>\n");
77 : overbeek 1.1 &HTML::show_page($cgi,$html);
78 :     exit;
79 :     }
80 : overbeek 1.3 else
81 :     {
82 : overbeek 1.8 if ($request eq "hypo_sub") { &handle_hypo_sub($fig,$cgi,$html,$genomes[0]) }
83 :     elsif ($request eq "hypo_nosub") { &handle_hypo_nosub($fig,$cgi,$html,$genomes[0]) }
84 :     elsif ($request eq "nothypo_sub") { &handle_nothypo_sub($fig,$cgi,$html,$genomes[0]) }
85 :     elsif ($request eq "nothypo_nosub") { &handle_nothypo_nosub($fig,$cgi,$html,$genomes[0]) }
86 :     elsif ($request eq "show_subsystems") { &handle_show_subsystems($fig,$cgi,$html,$genomes[0]) }
87 :     else
88 :     {
89 :     push(@$html,$cgi->h1("Invalid request: $request"));
90 :     }
91 : overbeek 1.3 }
92 : overbeek 1.1 &HTML::show_page($cgi,$html);
93 :     exit;
94 : overbeek 1.3
95 :     sub basic_stats {
96 :     my($fig,$cgi,$html,$genome) = @_;
97 :    
98 : overbeek 1.8 my($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy) = &get_basic_stats($fig,$genome);
99 : overbeek 1.3 push(@$html,$cgi->h1('Basic Statistics'));
100 :     push(@$html,$cgi->br,
101 : overbeek 1.8 "<b>Genome ID:</b> $genome",$cgi->br,
102 : overbeek 1.4 "<b>Name:</b> $gname",$cgi->br,
103 :     "<b>Size (bp):</b> $szdna",$cgi->br,
104 : overbeek 1.8 "<b>Number contigs:</b> $num_contigs",$cgi->br,
105 : overbeek 1.4 "<b>Number CDSs:</b> $pegs",$cgi->br,
106 :     "<b>Number rnas:</b> $rnas",$cgi->br,
107 :     "<b>Taxonomy:</b> $taxonomy",$cgi->br
108 : overbeek 1.3 );
109 :     return
110 :     }
111 : overbeek 1.4
112 :     sub commify {
113 :     my($n) = @_;
114 :     my(@n) = ();
115 :     my($i);
116 :    
117 :     for ($i = (length($n) - 3); ($i > 0); $i -= 3)
118 :     {
119 :     unshift(@n,",",substr($n,$i,3));
120 :     }
121 :     unshift(@n,substr($n,0,$i+3));
122 :     return join("",@n);
123 :     }
124 :    
125 :     sub assignment_stats {
126 :     my($fig,$cgi,$html,$genome) = @_;
127 :    
128 : overbeek 1.5 my $rdbH = $fig->db_handle;
129 :    
130 :     my $hypo_sub = 0;
131 :     my $hypo_nosub = 0;
132 :     my $nothypo_sub = 0;
133 :     my $nothypo_nosub = 0;
134 :    
135 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
136 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
137 :     my $in = keys(%in);
138 : overbeek 1.5
139 : overbeek 1.6 foreach $_ (@$assignments_data)
140 : overbeek 1.5 {
141 :     my($peg,$func) = @$_;
142 :     my $is_hypo = &FIG::hypo($func);
143 :    
144 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
145 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
146 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
147 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
148 :     }
149 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
150 :     my $fracHS = sprintf "%4.2f", $hypo_sub / $tot;
151 :     my $fracNHS = sprintf "%4.2f", $nothypo_sub / $tot;
152 :     my $fracHNS = sprintf "%4.2f", $hypo_nosub / $tot;
153 :     my $fracNHNS = sprintf "%4.2f", $nothypo_nosub / $tot;
154 : overbeek 1.6
155 :     my $user = $cgi->param('user');
156 : overbeek 1.5
157 : overbeek 1.6 push(@$html,"<b>PEGs with hypothetical functions and in subsystem:</b> <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub>$hypo_sub ($fracHS)</a>",$cgi->br,
158 :     "<b>PEGs with nonhypothetical functions and in subsystem:</b> <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub>$nothypo_sub ($fracNHS)</a>",$cgi->br,
159 :     "<b>PEGs with hypothetical functions and not in subsystem:</b> <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub>$hypo_nosub ($fracHNS)</a>",$cgi->br,
160 :     "<b>PEGs with nonhypothetical functions and not in subsystem:</b> <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub>$nothypo_nosub ($fracNHNS)</a>",$cgi->br
161 : overbeek 1.5 );
162 : overbeek 1.4 }
163 :    
164 : overbeek 1.5 sub handle_show_subsystems {
165 : overbeek 1.4 my($fig,$cgi,$html,$genome) = @_;
166 : overbeek 1.6 my(%in,$sub,$role,$protein,$sub_link);
167 : overbeek 1.4
168 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
169 :     foreach $_ (@$subsystem_data)
170 :     {
171 :     ($sub,$role,$protein) = @$_;
172 :     push(@{$in{$sub}->{$role}},&HTML::fid_link($cgi,$protein,0) . ": " . scalar $fig->function_of($protein));
173 :     }
174 :     foreach $sub (sort keys(%in))
175 :     {
176 :     $sub_link = &sub_link($cgi,$sub);
177 :     push(@$html,$cgi->h2($sub_link));
178 :     my $roles = [];
179 :     foreach $role (sort keys(%{$in{$sub}}))
180 :     {
181 :     push(@$roles,$cgi->ul($cgi->li($in{$sub}->{$role})));
182 :     }
183 :     push(@$html,$cgi->ul($cgi->li($roles)));
184 :     }
185 : overbeek 1.4 }
186 : overbeek 1.5
187 :     sub handle_hypo_sub {
188 :     my($fig,$cgi,$html,$genome) = @_;
189 :    
190 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
191 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
192 :     my $col_hdrs = ["PEG","Function","Subsystem"];
193 :     my $tab = [];
194 :     foreach $_ (@$assignments_data)
195 :     {
196 :     my($peg,$func) = @$_;
197 :     if (&FIG::hypo($func) && ($subs{$peg}))
198 :     {
199 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
200 :     }
201 :     }
202 :     $_ = @$tab;
203 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs in Subsystems"));
204 : overbeek 1.5 }
205 :    
206 :     sub handle_hypo_nosub {
207 :     my($fig,$cgi,$html,$genome) = @_;
208 :    
209 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
210 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
211 :     my $col_hdrs = ["PEG","Function"];
212 :     my $tab = [];
213 :     foreach $_ (@$assignments_data)
214 :     {
215 :     my($peg,$func) = @$_;
216 :     if (&FIG::hypo($func) && (! $subs{$peg}))
217 :     {
218 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
219 :     }
220 :     }
221 :     $_ = @$tab;
222 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs NOT in Subsystems"));
223 : overbeek 1.5 }
224 :    
225 :     sub handle_nothypo_sub {
226 :     my($fig,$cgi,$html,$genome) = @_;
227 :    
228 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
229 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
230 :     my $col_hdrs = ["PEG","Function","Subsystem"];
231 :     my $tab = [];
232 :     foreach $_ (@$assignments_data)
233 :     {
234 :     my($peg,$func) = @$_;
235 :     if ((! &FIG::hypo($func)) && ($subs{$peg}))
236 :     {
237 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
238 :     }
239 :     }
240 :     $_ = @$tab;
241 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs in Subsystems"));
242 : overbeek 1.5 }
243 :    
244 :     sub handle_nothypo_nosub {
245 :     my($fig,$cgi,$html,$genome) = @_;
246 :    
247 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
248 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
249 :     my $col_hdrs = ["PEG","Function"];
250 :     my $tab = [];
251 :     foreach $_ (@$assignments_data)
252 :     {
253 :     my($peg,$func) = @$_;
254 :     if ((! &FIG::hypo($func)) && (! $subs{$peg}))
255 :     {
256 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
257 :     }
258 :     }
259 :     $_ = @$tab;
260 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs NOT in Subsystems"));
261 : overbeek 1.5 }
262 :    
263 : overbeek 1.6 sub get_data {
264 :     my($fig,$cgi,$genome) = @_;
265 :    
266 :     my $rdbH = $fig->db_handle;
267 :     my $subsystem_data = $rdbH->SQL("SELECT DISTINCT subsystem,role,protein FROM subsystem_index WHERE ( protein like 'fig\|$genome.peg.%')");
268 :     my $assignment_data = $rdbH->SQL("SELECT prot,assigned_function FROM assigned_functions WHERE ( prot like 'fig\|$genome.peg.%' AND made_by = 'master' )");
269 :    
270 :     return ($subsystem_data,$assignment_data);
271 :     }
272 :    
273 :     sub sub_link {
274 :     my($cgi,$sub) = @_;
275 :     my($sub_link);
276 :    
277 :     my $user = $cgi->param('user');
278 :     if ($user)
279 :     {
280 :     $sub_link = "<a href=./subsys.cgi?ssa_name=$sub&request=show_ssa&user=$user>$sub</a>";
281 :     }
282 :     else
283 :     {
284 :     $sub_link = $sub;
285 :     }
286 :     return $sub_link;
287 :     }
288 : overbeek 1.8
289 :     sub get_basic_stats {
290 :     my($fig,$genome) = @_;
291 :    
292 :     my $rdbH = $fig->db_handle;
293 :     my $relational_db_response = $rdbH->SQL("SELECT gname,szdna,pegs,rnas,taxonomy FROM genome WHERE genome = '$genome'");
294 :     my($gname,$szdna,$pegs,$rnas,$taxonomy) = @{$relational_db_response->[0]};
295 :     my $szdna = &commify($szdna);
296 :     my $num_contigs = scalar $fig->all_contigs($genome);
297 :     return ($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy);
298 :     }
299 :    
300 :     sub table_of_genomes {
301 :     my($fig,$cgi,$html) = @_;
302 :     my(@genomes);
303 :    
304 :     push(@$html,"<pre>\n");
305 :     if ($cgi->param('complete'))
306 :     {
307 :     @genomes = $fig->genomes("complete");
308 :     }
309 :     else
310 :     {
311 :     @genomes = $fig->genomes;
312 :     }
313 :    
314 :     my $genome;
315 :     push(@$html,join("\t","Genome ID","Complete","Genome Name","Size (bp)","Number Contigs","CDSs","RNAs","Taxonomy") . "\n");
316 :     my $genome;
317 :     foreach $genome (@genomes)
318 :     {
319 :     push(@$html,join("\t",($genome,$fig->is_complete($genome),&get_basic_stats($fig,$genome))) . "\n");
320 :     }
321 :     push(@$html,"</pre>\n");
322 :     }
323 :    
324 :    
325 : overbeek 1.9 sub subsys_summary {
326 :     my($fig,$cgi,$html) = @_;
327 :     my($Nsubs,$genome,$sub,$role,$peg,$genome_instances,%genomes_in_use,$peg_instances,%pegs_in_use);
328 :     foreach $sub ($fig->all_subsystems)
329 :     {
330 :     $Nsubs++;
331 :     foreach $genome (map { $_->[0] } @{$fig->subsystem_genomes($sub)})
332 :     {
333 :     $genome_instances++;
334 :     $genomes_in_use{$genome}++;
335 :     foreach $role ($fig->subsystem_to_roles($sub))
336 :     {
337 :     foreach $peg ($fig->pegs_in_subsystem_cell($sub,$genome,$role))
338 :     {
339 :     $peg_instances++;
340 :     $pegs_in_use{$peg}++;
341 :     }
342 :     }
343 :     }
344 :     }
345 :     my $Ngenomes = scalar keys(%genomes_in_use);
346 :     my $Npegs = scalar keys(%pegs_in_use);
347 :     my $g_in_sub = int($genome_instances / $Nsubs);
348 :     my $p_in_sub = int($peg_instances / $Nsubs);
349 :     push(@$html,$cgi->h1('Subsystem Summary'));
350 :     push(@$html,$cgi->br,
351 :     "<b>Number Subsystems:</b> $Nsubs",$cgi->br,
352 :     "<b>Genomes in Subsystems:</b> $Ngenomes",$cgi->br,
353 :     "<b>PEGs in Subsystems:</b> $Npegs",$cgi->br,
354 :     "<b>Avg genomes per subsystem:</b> $g_in_sub",$cgi->br,
355 :     "<b>Avg PEGs per subsystem:</b> $p_in_sub",$cgi->br
356 :     );
357 :     return
358 :    
359 :     }
360 : redwards 1.10
361 :     sub kv_stats {
362 :     my ($fig, $cgi, $html, $genome, $edit)=@_;
363 :    
364 :     # RAE Added tables for key value pairs for an organism, and allow you to edit them
365 :     # figure out kv's for the organism, and make a table with them
366 :    
367 :     # if the optional edit boolean is set and a user is supplied, we will make a table where you can edit the KV pairs
368 :     # else we will just make a blank table
369 :    
370 :     my $tab=[];
371 :     my $user=$cgi->param('user');
372 :     my $col_hdrs=["Attribute", "Value"];
373 : redwards 1.11 if ($user && $edit) {$col_hdrs=["Attribute", "Value", "URL"]}
374 : redwards 1.10
375 :     my $known;
376 :     foreach my $key (sort {$a->[0] cmp $b->[0]} $fig->get_attributes($genome)) {
377 :     $known->{$key->[0]}=1;
378 :     if ($user && $edit) {
379 :     push @$tab,
380 :     [
381 :     $key->[0],
382 :     $cgi->textfield(-name=>"value.".$key->[0], -default=>$key->[1], -size=>50),
383 :     $cgi->textfield(-name=>"url.".$key->[0], -default=>$key->[2], -size=>50),
384 :     ];
385 :     } else {
386 :     if ($key->[2] && $key->[2] =~ /^http/) {$key->[1] = "<a href=\"" . $key->[2] . "\">". $key->[1] . "</a>"}
387 :     push @$tab,
388 :     [
389 :     $key->[0],
390 :     $key->[1],
391 :     ];
392 :     }
393 :     }
394 :    
395 :    
396 :     if ($edit) {
397 :     # now we want to add some pull down menus for things that we can add. And some blank boxes too for free text entry.
398 :     # start with three of each
399 :     my $opt=$fig->get_tags("genome"); # all the tags we know about
400 :     my @options=sort {uc($a) cmp uc($b)} grep {!$known->{$_}} keys %$opt;
401 :     unshift(@options, undef); # a blank field at the start
402 :     for (my $i=1; $i<= (scalar @options + 5); $i++) {
403 :    
404 :     # we have the options, and 5 blank fields for free text entry
405 :     my $choice=$cgi->popup_menu(-name=>"key.$i", -values=>\@options);
406 :     if ($i >= scalar @options) {$choice = $cgi->textfield(-name=>"key.$i", -size=>50)}
407 :     push @$tab,
408 :     [
409 :     $choice,
410 :     $cgi->textfield(-name=>"value.$i", -size=>50),
411 :     $cgi->textfield(-name=>"url.$i", -size=>50),
412 :     ];
413 :     }
414 :     }
415 :    
416 :     # now just write the html
417 :     if ($edit) {push(@$html, $cgi->start_form(-action=>"genome_statistics.cgi"))}
418 :     push(@$html, "\n<div class=\"attributes\">\n<p><h2>Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
419 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Attributes"));
420 :     if ($edit) {
421 :     push(@$html, $cgi->hidden("genome"), $cgi->hidden("user"), $cgi->hidden("request"));
422 :     push(@$html, $cgi->submit('Change'), $cgi->reset());
423 :     }
424 :     else {
425 :     push(@$html,"<p><a href=./genome_statistics.cgi?genome=$genome&request=edit_kv_stats&change=0&user=$user>Edit Key Value Pairs</a></p>\n</div>\n");
426 :     }
427 :     }
428 :    
429 :    
430 :     sub edit_kv_stats {
431 :     my ($fig, $cgi, $html, $genome)=@_;
432 :     if ($cgi->param("Change")) {
433 :     # we have changed the values
434 :     # get the old kv pairs so we can see what has changed
435 :     my $changed; my $deleted;
436 :     foreach my $key ($fig->get_attributes($genome)) {
437 :     if (!$cgi->param('value.'.$key->[0]) && !$cgi->param('url.'.$key->[0])) {
438 :     $fig->delete_attribute($genome, $key->[0]);
439 :     push @$key, ["deleted", "td colspan=2 style=\"text-align: center\""];
440 :     push @$deleted, $key;
441 :     }
442 :     elsif (($cgi->param('value.'.$key->[0]) ne $key->[1]) || ($cgi->param('url.'.$key->[0]) ne $key->[2])) {
443 :     $fig->change_attribute($genome, $key->[0], $cgi->param('value.'.$key->[0]), $cgi->param('url.'.$key->[0]));
444 :     push @$key, $cgi->param('value.'.$key->[0]), $cgi->param('url.'.$key->[0]);
445 :     push @$changed, $key;
446 :     }
447 :     }
448 :    
449 :     my $added;
450 :     for (my $i=0; $i <=6; $i++) {
451 :     if ($cgi->param("key.$i")) {
452 :     $fig->add_attribute($genome, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"));
453 :     push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
454 :     }
455 :     }
456 :    
457 :     # now all we have to do is create a table to report what we have done.
458 :     my $tab=[];
459 :     push (@$html, "<div class=\"altered\"><p><h2>Attributes Altered for ", $fig->genus_species($genome), " ($genome)</h2></p>");
460 :     my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
461 :     if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
462 :     if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
463 :     if ($added) {push @$tab, [["<strong>Added Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}
464 :    
465 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Changed Data"));
466 :     }
467 :     else {
468 :     return kv_stats($fig, $cgi, $html, $genome, 1);
469 :     }
470 :     }
471 :    
472 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3