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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.42 - (view) (download)

1 : redwards 1.10 # -*- perl -*-
2 : olson 1.33 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : overbeek 1.1 #### start ####
20 : overbeek 1.5
21 : overbeek 1.1 use FIG;
22 : disz 1.35 use FIG_Config;
23 : overbeek 1.1 my $fig = new FIG;
24 :    
25 :     use HTML;
26 :     use strict;
27 :     use CGI;
28 :     my $cgi = new CGI;
29 :    
30 : overbeek 1.2 if (0)
31 : overbeek 1.1 {
32 :     my $VAR1;
33 :     eval(join("",`cat /tmp/statistics_parms`));
34 :     $cgi = $VAR1;
35 :     # print STDERR &Dumper($cgi);
36 :     }
37 :    
38 :     if (0)
39 :     {
40 :     print $cgi->header;
41 :     my @params = $cgi->param;
42 :     print "<pre>\n";
43 :     foreach $_ (@params)
44 :     {
45 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
46 :     }
47 :    
48 :     if (0)
49 :     {
50 :     if (open(TMP,">/tmp/statistics_parms"))
51 :     {
52 :     print TMP &Dumper($cgi);
53 :     close(TMP);
54 :     }
55 :     }
56 :     exit;
57 :     }
58 :    
59 : overbeek 1.32 # DISABLED ATTRIBUTES
60 :     # I have disabled attributes because it is taking so long to load. The places where I have disabled them are marked with "DISABLED ATTRIBUTES"
61 :     # RAE 10/25/05
62 :    
63 : overbeek 1.41 # RAE: 3/21/06
64 :     # Re-enabled attributes, but left old markers in place for now!
65 : overbeek 1.32
66 :    
67 : overbeek 1.1 my $html = [];
68 : olson 1.7 unshift @$html, "<TITLE>The SEED Statistics Page</TITLE>\n";
69 : overbeek 1.1
70 : overbeek 1.8 my @genomes = $cgi->param('genome');
71 :     my $request = $cgi->param('request');
72 : disz 1.35 my $nmpdr = $cgi->param('SPROUT');
73 : overbeek 1.9
74 : overbeek 1.40 my $sprout_param;
75 :     if ($nmpdr)
76 :     {
77 :     push(@$html, "SPROUT is on<br>\n");
78 :     $sprout_param = "&SPROUT=1";
79 :     }
80 :    
81 : overbeek 1.32 # RAE This little loop will add any genomes for any proteins that we know about to the list
82 :     push @genomes, map{$fig->genome_of($_)} $cgi->param('prot');
83 :    
84 : overbeek 1.24 if (!$request)
85 :     {
86 :     #
87 :     # Support for coming here from the NMPDR pages, where we have a form
88 :     # with a pair of submit buttons, one for subsystems summary, one for
89 :     # reactions summary.
90 :     #
91 :    
92 :     if ($cgi->param("show_reactions"))
93 :     {
94 : disz 1.35 warn "have show reactions\n";
95 : overbeek 1.24 $request = "show_reactions";
96 :     }
97 :     elsif ($cgi->param("show_subsystems"))
98 :     {
99 : overbeek 1.31 # warn "have show subsystems\n";
100 : overbeek 1.24 $request = "show_subsystems";
101 :     }
102 :     }
103 :    
104 : olson 1.27 # warn "REQ='$request'\n";
105 : overbeek 1.24
106 : overbeek 1.9 if ($request eq "subsystems_summary")
107 :     {
108 :     &subsys_summary($fig,$cgi,$html);
109 :     }
110 : redwards 1.10 elsif ($request eq "edit_kv_stats") {
111 :     &edit_kv_stats($fig,$cgi,$html, $cgi->param('genome'));
112 :     }
113 : overbeek 1.9 elsif ((@genomes == 0) && (! $request))
114 : overbeek 1.8 {
115 :     &table_of_genomes($fig,$cgi,$html);
116 :     }
117 :     elsif (! $request)
118 :     {
119 :     my $genome;
120 :     foreach $genome (@genomes)
121 :     {
122 :     &basic_stats($fig,$cgi,$html,$genome);
123 :     push(@$html,$cgi->hr);
124 :     &assignment_stats($fig,$cgi,$html,$genome);
125 :     push(@$html,$cgi->hr);
126 : redwards 1.14 &kv_peg_stats($fig, $cgi, $html, $genome);
127 :     push(@$html,$cgi->hr);
128 : redwards 1.10 &kv_stats($fig, $cgi, $html, $genome);
129 : overbeek 1.19 my $user = $cgi->param('user');
130 : overbeek 1.21 push(@$html,"<a href=./genome_statistics.cgi?genome=$genome&request=show_subsystems&user=$user>Show Subsystems</a><br>\n");
131 :     push(@$html,"<a href=./genome_statistics.cgi?genome=$genome&request=show_reactions&user=$user>Show Reactions</a><br>\n");
132 : overbeek 1.23 if (&model_for_genome($genome))
133 :     {
134 :     push(@$html,"<a href=./status_of_model.cgi?user=$user&model=$genome>PEGs in published reaction model that are not yet covered</a><br>\n");
135 :     }
136 : overbeek 1.8 push(@$html,$cgi->br);
137 :     }
138 :     }
139 :     elsif (@genomes == 0)
140 : overbeek 1.1 {
141 : overbeek 1.8 push(@$html,"<h1>Sorry, you need to specify at least one valid genome</h1>\n");
142 : overbeek 1.1 }
143 : overbeek 1.3 else
144 :     {
145 : golsen 1.16 if ($request eq "hypo_sub") { &handle_hypo_sub($fig,$cgi,$html,$genomes[0]) }
146 : overbeek 1.8 elsif ($request eq "hypo_nosub") { &handle_hypo_nosub($fig,$cgi,$html,$genomes[0]) }
147 :     elsif ($request eq "nothypo_sub") { &handle_nothypo_sub($fig,$cgi,$html,$genomes[0]) }
148 :     elsif ($request eq "nothypo_nosub") { &handle_nothypo_nosub($fig,$cgi,$html,$genomes[0]) }
149 :     elsif ($request eq "show_subsystems") { &handle_show_subsystems($fig,$cgi,$html,$genomes[0]) }
150 : overbeek 1.21 elsif ($request eq "show_reactions") { &handle_show_reactions($fig,$cgi,$html,$genomes[0]) }
151 : overbeek 1.8 else
152 :     {
153 :     push(@$html,$cgi->h1("Invalid request: $request"));
154 :     }
155 : overbeek 1.3 }
156 : overbeek 1.1 &HTML::show_page($cgi,$html);
157 :     exit;
158 : overbeek 1.3
159 : golsen 1.16
160 :     # Only subroutines below
161 :    
162 :    
163 : overbeek 1.3 sub basic_stats {
164 :     my($fig,$cgi,$html,$genome) = @_;
165 :    
166 : overbeek 1.8 my($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy) = &get_basic_stats($fig,$genome);
167 : golsen 1.16 push @$html, $cgi->h1('Basic Statistics'), "\n",
168 :     "<b>Genome ID:</b> $genome", $cgi->br, "\n",
169 :     "<b>Name:</b> $gname", $cgi->br, "\n",
170 :     "<b>Size (bp):</b> $szdna", $cgi->br, "\n",
171 :     "<b>Number contigs:</b> $num_contigs", $cgi->br, "\n",
172 :     "<b>Number CDSs:</b> $pegs", $cgi->br, "\n",
173 :     "<b>Number rnas:</b> $rnas", $cgi->br, "\n",
174 : overbeek 1.42 "<b>Taxonomy:</b> $taxonomy", $cgi->br, "\n",
175 :     "<b>Complete:</b> ", $fig->is_complete($genome)?"Yes":"No", $cgi->br;
176 : golsen 1.16 push @$html, project_description( $genome );
177 : overbeek 1.3 return
178 :     }
179 : overbeek 1.4
180 : golsen 1.16
181 :     sub project_description {
182 :     ( my $genome = shift @_ ) or return ();
183 :     -d $FIG_Config::organisms && -d "$FIG_Config::organisms/$genome"
184 :     && -f "$FIG_Config::organisms/$genome/PROJECT"
185 :     || return ();
186 :     open( PROJECT, "<$FIG_Config::organisms/$genome/PROJECT" ) || return ();
187 :     my @project = <PROJECT>;
188 :     close PROJECT;
189 :     return ( "<b>Project description:</b>\n<pre>",
190 :     ( map { " " . $_ } @project ),
191 :     "</pre>\n"
192 :     );
193 :     }
194 :    
195 :    
196 : overbeek 1.4 sub commify {
197 :     my($n) = @_;
198 :     my(@n) = ();
199 :     my($i);
200 :    
201 :     for ($i = (length($n) - 3); ($i > 0); $i -= 3)
202 :     {
203 :     unshift(@n,",",substr($n,$i,3));
204 :     }
205 :     unshift(@n,substr($n,0,$i+3));
206 :     return join("",@n);
207 :     }
208 :    
209 :     sub assignment_stats {
210 :     my($fig,$cgi,$html,$genome) = @_;
211 :    
212 : overbeek 1.5 my $rdbH = $fig->db_handle;
213 :    
214 :     my $hypo_sub = 0;
215 :     my $hypo_nosub = 0;
216 :     my $nothypo_sub = 0;
217 :     my $nothypo_nosub = 0;
218 :    
219 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
220 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
221 :     my $in = keys(%in);
222 : overbeek 1.5
223 : overbeek 1.34 my %sscount = map { $_->[0] => 1 } @$subsystem_data;
224 :     my $nss=scalar(keys(%sscount));
225 :    
226 : overbeek 1.6 foreach $_ (@$assignments_data)
227 : overbeek 1.5 {
228 :     my($peg,$func) = @$_;
229 :     my $is_hypo = &FIG::hypo($func);
230 :    
231 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
232 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
233 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
234 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
235 :     }
236 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
237 : efrank 1.30
238 :     my ($fracHS, $fracNHS, $fracHNS, $fracNHNS);
239 :    
240 :     if ($tot == 0) {
241 : overbeek 1.31 $fracHS = sprintf "%4.2f", 0.0;
242 :     $fracNHS = sprintf "%4.2f", 0.0;
243 :     $fracHNS = sprintf "%4.2f", 0.0;
244 : efrank 1.30 my $fracNHNS = sprintf "%4.2f", 0.0;
245 :     } else {
246 : overbeek 1.31 $fracHS = sprintf "%4.2f", $hypo_sub / $tot;
247 :     $fracNHS = sprintf "%4.2f", $nothypo_sub / $tot;
248 :     $fracHNS = sprintf "%4.2f", $hypo_nosub / $tot;
249 :     $fracNHNS = sprintf "%4.2f", $nothypo_nosub / $tot;
250 : efrank 1.30 }
251 :    
252 : overbeek 1.6 my $user = $cgi->param('user');
253 : overbeek 1.5
254 : golsen 1.16 push @$html, "<table>\n",
255 :     " <tr>\n",
256 : overbeek 1.34 " <th align=left>Number of subsystems:</th>\n",
257 :     " <td align=right><a href=\"subsys_vectors.cgi?korgs=$genome&allss=1\">$nss</a></td>\n",
258 :     " </tr>\n",
259 :     " <tr>\n",
260 : golsen 1.16 " <th align=left>PEGs with hypothetical functions and in subsystem:</th>\n",
261 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub>$hypo_sub ($fracHS)</a></td>\n",
262 :     " </tr>\n",
263 :     " <tr>\n",
264 :     " <th align=left>PEGs with nonhypothetical functions and in subsystem:</th>\n",
265 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub>$nothypo_sub ($fracNHS)</a></td>\n",
266 :     " </tr>\n",
267 :     " <tr>\n",
268 :     " <th align=left>PEGs with hypothetical functions and not in subsystem:</th>\n",
269 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub>$hypo_nosub ($fracHNS)</a></td>\n",
270 :     " </tr>\n",
271 :     " <tr>\n",
272 :     " <th align=left>PEGs with nonhypothetical functions and not in subsystem:</th>\n",
273 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub>$nothypo_nosub ($fracNHNS)</a></td>\n",
274 :     " </tr>\n",
275 :     "</table>\n";
276 : overbeek 1.4 }
277 : disz 1.35 sub sub_stats {
278 :     my($fig,$cgi,$genome) = @_;
279 :    
280 :     my $rdbH = $fig->db_handle;
281 :    
282 :     my $hypo_sub = 0;
283 :     my $hypo_nosub = 0;
284 :     my $nothypo_sub = 0;
285 :     my $nothypo_nosub = 0;
286 :     my $fracHS;
287 :     my $fracNHS;
288 :     my $fracHNS;
289 :     my $fracNHNS;
290 :    
291 :     my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
292 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
293 :     my $in = keys(%in);
294 :    
295 :     #print STDERR &Dumper($genome, $assignments_data, $subsystem_data);
296 :     foreach $_ (@$assignments_data)
297 :     {
298 :     my($peg,$func) = @$_;
299 :     my $is_hypo = &FIG::hypo($func);
300 :    
301 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
302 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
303 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
304 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
305 :     }
306 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
307 :    
308 :     if ($tot) {
309 :     $fracHS = sprintf "%d (%4.1f%%)", $hypo_sub, 100 * $hypo_sub / $tot;
310 :     $fracNHS = sprintf "%d (%4.1f%%)", $nothypo_sub, 100 * $nothypo_sub / $tot;
311 :     $fracHNS = sprintf "%d (%4.1f%%)", $hypo_nosub, 100 * $hypo_nosub / $tot;
312 :     $fracNHNS = sprintf "%d (%4.1f%%)", $nothypo_nosub, 100 * $nothypo_nosub / $tot;
313 :     } else {
314 :     $fracHS = 0;
315 :     $fracNHS = 0;
316 :     $fracHNS = 0;
317 :     $fracNHNS = 0;
318 :     }
319 :    
320 :     return ($fracHS, $fracHNS, $fracNHS, $fracNHNS);
321 :     }
322 : overbeek 1.4
323 : overbeek 1.5 sub handle_show_subsystems {
324 : overbeek 1.4 my($fig,$cgi,$html,$genome) = @_;
325 : overbeek 1.19 my(%in,$sub,$role,$protein,$sub_link,$tuple,$categories);
326 : overbeek 1.4
327 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
328 : overbeek 1.25 my $active = $fig->active_subsystems($genome);
329 : disz 1.35 push(@$html,$cgi->h1($genome));
330 : overbeek 1.6 foreach $_ (@$subsystem_data)
331 :     {
332 :     ($sub,$role,$protein) = @$_;
333 : overbeek 1.25 if ($active->{$sub})
334 :     {
335 :     push(@{$in{$sub}->{$role}},&HTML::fid_link($cgi,$protein,0) . ": " . scalar $fig->function_of($protein));
336 :     }
337 : overbeek 1.6 }
338 : overbeek 1.19
339 :     my @subs = sort { ($a->[0] cmp $b->[0]) or
340 :     ($a->[1] cmp $b->[1]) or
341 :     ($a->[2] cmp $b->[2]) or
342 :     ($a->[3] cmp $b->[3]) or
343 :     ($a->[4] cmp $b->[4])
344 :     }
345 :     map { $sub = $_;
346 :     $categories = $fig->subsystem_classification($sub);
347 :     $categories = ((@$categories > 0) && $categories->[0]) ? $categories : ["Misc"];
348 :     [@$categories,$sub]
349 :     }
350 :     keys(%in);
351 :    
352 : overbeek 1.20 my $last1 = "";
353 :     my $last2 = "";
354 : overbeek 1.19 foreach $tuple (@subs)
355 :     {
356 :     $sub = pop @{$tuple};
357 :     my $topic = $tuple->[0];
358 : overbeek 1.20
359 :     if ($topic ne $last1)
360 :     {
361 :     push(@$html,$cgi->h1($topic));
362 :     $last1 = $topic;
363 :     $last2 = "";
364 :     }
365 :    
366 :     $topic = $tuple->[1] ? $tuple->[1] : "";
367 :     if ($topic && ($topic ne $last2))
368 : overbeek 1.19 {
369 :     push(@$html,$cgi->h2($topic));
370 : overbeek 1.20 $last2 = $topic;
371 : overbeek 1.19 }
372 : overbeek 1.20
373 : overbeek 1.6 $sub_link = &sub_link($cgi,$sub);
374 : overbeek 1.19 push(@$html,$cgi->h3($sub_link));
375 :    
376 : overbeek 1.6 my $roles = [];
377 :     foreach $role (sort keys(%{$in{$sub}}))
378 :     {
379 :     push(@$roles,$cgi->ul($cgi->li($in{$sub}->{$role})));
380 :     }
381 :     push(@$html,$cgi->ul($cgi->li($roles)));
382 :     }
383 : overbeek 1.4 }
384 : overbeek 1.5
385 : overbeek 1.21 sub handle_show_reactions {
386 :     my($fig,$cgi,$html,$genome) = @_;
387 :     my($react_for_role,$r,%topic,%reaction,$sub,$role,$protein,$sub_link,$tuple,$categories);
388 :     my(%reactions_for_sub,%class,$reactions,$classL,$category);
389 :    
390 :     my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
391 : overbeek 1.24
392 : overbeek 1.21 foreach $_ (@$subsystem_data)
393 :     {
394 :     ($sub,$role,$protein) = @$_;
395 :     if (! defined($reactions_for_sub{$sub}))
396 :     {
397 :     my $subsystem = new Subsystem($sub,$fig,0);
398 :     $reactions = $subsystem->get_reactions;
399 :     $reactions = $reactions ? $reactions : "";
400 :     $reactions_for_sub{$sub} = $reactions;
401 :     $class{$sub} = $fig->subsystem_classification($sub);
402 :     }
403 :    
404 :     if (($reactions = $reactions_for_sub{$sub}) && ($react_for_role = $reactions->{$role}))
405 :     {
406 :     $classL = $class{$sub};
407 :     $category = ((@$classL > 0) && $classL->[0]) ? $classL->[0] : "Misc";
408 :     foreach $r (@$react_for_role)
409 :     {
410 : overbeek 1.26 if ($fig->valid_reaction_id($r))
411 :     {
412 :     $reaction{$r}->{$protein} = 1;
413 :     $topic{$category}->{$r} = 1;
414 :     }
415 : overbeek 1.21 }
416 :     }
417 :     }
418 :    
419 :     my @all = sort { $a cmp $b } keys(%topic);
420 : overbeek 1.24
421 :     if (@all == 0)
422 :     {
423 :     push(@$html, $cgi->p("No class reactions found."));
424 :     }
425 : overbeek 1.21 foreach $category (@all)
426 :     {
427 : overbeek 1.22 &show_class_react($fig,$cgi,$html,$category,[keys(%{$topic{$category}})],\%reaction);
428 : overbeek 1.21 }
429 :    
430 :     if ($_ = $topic{"Misc"})
431 :     {
432 : overbeek 1.22 &show_class_react($fig,$cgi,$html,'Misc',[keys(%$_)],\%reaction);
433 : overbeek 1.21 }
434 : overbeek 1.24 else
435 :     {
436 :     push(@$html, $cgi->p("No misc reactions found."));
437 :     }
438 :    
439 : overbeek 1.21 }
440 :    
441 :     sub show_class_react {
442 :     my($fig,$cgi,$html,$class,$for_topic,$reaction) = @_;
443 :     my($r,@pegs,$peg);
444 :    
445 :     push(@$html,$cgi->h1($class));
446 : overbeek 1.22 foreach $r (sort @$for_topic)
447 : overbeek 1.21 {
448 :     my $disp_react = $fig->displayable_reaction($r);
449 :     $disp_react =~ s/^R\d+\: //;
450 :    
451 :     my $rstring = &HTML::reaction_link($r) . ": $disp_react";
452 :     push(@$html,$cgi->h2($rstring),"\n");
453 :     @pegs = sort { &FIG::by_fig_id($a,$b) } keys(%{$reaction->{$r}});
454 :     push(@$html,"<ul>\n");
455 :     foreach $peg (@pegs)
456 :     {
457 :     push(@$html,"<li>" . &HTML::fid_link($cgi,$peg) . " " . scalar $fig->function_of($peg) . "\n");
458 :     }
459 :     push(@$html,"</ul>\n");
460 :     }
461 :     }
462 :    
463 : overbeek 1.5 sub handle_hypo_sub {
464 :     my($fig,$cgi,$html,$genome) = @_;
465 :    
466 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
467 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
468 :     my $col_hdrs = ["PEG","Function","Subsystem"];
469 :     my $tab = [];
470 :     foreach $_ (@$assignments_data)
471 :     {
472 :     my($peg,$func) = @$_;
473 :     if (&FIG::hypo($func) && ($subs{$peg}))
474 :     {
475 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
476 :     }
477 :     }
478 :     $_ = @$tab;
479 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs in Subsystems"));
480 : overbeek 1.5 }
481 :    
482 :     sub handle_hypo_nosub {
483 :     my($fig,$cgi,$html,$genome) = @_;
484 :    
485 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
486 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
487 :     my $col_hdrs = ["PEG","Function"];
488 :     my $tab = [];
489 :     foreach $_ (@$assignments_data)
490 :     {
491 :     my($peg,$func) = @$_;
492 :     if (&FIG::hypo($func) && (! $subs{$peg}))
493 :     {
494 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
495 :     }
496 :     }
497 :     $_ = @$tab;
498 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs NOT in Subsystems"));
499 : overbeek 1.5 }
500 :    
501 :     sub handle_nothypo_sub {
502 :     my($fig,$cgi,$html,$genome) = @_;
503 :    
504 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
505 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
506 :     my $col_hdrs = ["PEG","Function","Subsystem"];
507 :     my $tab = [];
508 :     foreach $_ (@$assignments_data)
509 :     {
510 :     my($peg,$func) = @$_;
511 :     if ((! &FIG::hypo($func)) && ($subs{$peg}))
512 :     {
513 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
514 :     }
515 :     }
516 :     $_ = @$tab;
517 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs in Subsystems"));
518 : overbeek 1.5 }
519 :    
520 :     sub handle_nothypo_nosub {
521 :     my($fig,$cgi,$html,$genome) = @_;
522 :    
523 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
524 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
525 :     my $col_hdrs = ["PEG","Function"];
526 :     my $tab = [];
527 :     foreach $_ (@$assignments_data)
528 :     {
529 :     my($peg,$func) = @$_;
530 :     if ((! &FIG::hypo($func)) && (! $subs{$peg}))
531 :     {
532 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
533 :     }
534 :     }
535 :     $_ = @$tab;
536 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs NOT in Subsystems"));
537 : overbeek 1.5 }
538 :    
539 : overbeek 1.6 sub get_data {
540 :     my($fig,$cgi,$genome) = @_;
541 :    
542 :     my $rdbH = $fig->db_handle;
543 : olson 1.27
544 :     #
545 :     # For now need to try with variant first, then back off to not using variant
546 :     # if we hit a database error.
547 :     #
548 :    
549 :     my $subsystem_data;
550 :    
551 :     {
552 :     my $dbh = $rdbH->{_dbh};
553 :     local $dbh->{RaiseError} = 1;
554 :     local $dbh->{PrintError} = 0;
555 :    
556 :     eval {
557 :     $subsystem_data = $rdbH->SQL(qq(SELECT DISTINCT subsystem,role,protein
558 :     FROM subsystem_index
559 :     WHERE (protein like 'fig\|$genome.peg.%' AND
560 :     variant != '-1')
561 :     ));
562 :     };
563 :     }
564 :     if ($@ =~ /variant/)
565 :     {
566 :     $subsystem_data = $rdbH->SQL(qq(SELECT DISTINCT subsystem,role,protein
567 :     FROM subsystem_index
568 :     WHERE (protein like 'fig\|$genome.peg.%')
569 :     ));
570 :     }
571 : overbeek 1.6 my $assignment_data = $rdbH->SQL("SELECT prot,assigned_function FROM assigned_functions WHERE ( prot like 'fig\|$genome.peg.%' AND made_by = 'master' )");
572 :    
573 :     return ($subsystem_data,$assignment_data);
574 :     }
575 :    
576 :     sub sub_link {
577 :     my($cgi,$sub) = @_;
578 :    
579 : overbeek 1.29 my $genome = $cgi->param('genome');
580 : overbeek 1.6 my $user = $cgi->param('user');
581 : overbeek 1.19 $user = defined($user) ? $user : "";
582 : overbeek 1.40 my $sub_link = "<a href=./display_subsys.cgi?ssa_name=$sub$sprout_param&request=show_ssa&user=$user&focus=$genome&show_clusters=1>$sub</a>";
583 : overbeek 1.19
584 : overbeek 1.6 return $sub_link;
585 :     }
586 : overbeek 1.8
587 :     sub get_basic_stats {
588 :     my($fig,$genome) = @_;
589 :    
590 :     my $rdbH = $fig->db_handle;
591 :     my $relational_db_response = $rdbH->SQL("SELECT gname,szdna,pegs,rnas,taxonomy FROM genome WHERE genome = '$genome'");
592 :     my($gname,$szdna,$pegs,$rnas,$taxonomy) = @{$relational_db_response->[0]};
593 :     my $szdna = &commify($szdna);
594 :     my $num_contigs = scalar $fig->all_contigs($genome);
595 :     return ($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy);
596 :     }
597 :    
598 :     sub table_of_genomes {
599 :     my($fig,$cgi,$html) = @_;
600 :     my(@genomes);
601 :    
602 : disz 1.35 # push(@$html,"<pre>\n");
603 : overbeek 1.8 if ($cgi->param('complete'))
604 :     {
605 : disz 1.39 @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes("complete"));
606 : overbeek 1.8 }
607 :     else
608 :     {
609 : disz 1.39 @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes);
610 : overbeek 1.8 }
611 :    
612 : disz 1.35 my (@rows, @headings);
613 : overbeek 1.8 my $genome;
614 : disz 1.35 #push(@$html,join("\t","Genome ID","Complete","Genome Name","Size (bp)","Number Contigs","CDSs","RNAs","Taxonomy") . "\n");
615 :    
616 :     @headings = ("Genome ID","Complete","Genome Name",
617 : overbeek 1.36 "Size (bp)", "Number Contigs", "CDSs", "Non-Hypothetical in Subsystem", "Non-Hypothetical not in Subsystem", "Hypothetical in Subsystem", "Hypothetical not in Subsystem", "RNAs","Taxonomy");
618 : disz 1.35 @rows = $cgi->th(\@headings);
619 :    
620 :     my $title;
621 :    
622 : disz 1.37 my $user = $cgi->param('user');
623 : overbeek 1.8 foreach $genome (@genomes)
624 :     {
625 : disz 1.35 if (! $nmpdr || -f "$FIG_Config::organisms/$genome/NMPDR") {
626 :     my ($name, $size, $number_contigs, $cds, $rnas, $tax) = &get_basic_stats($fig, $genome);
627 :     my ($hs, $hns, $nhs, $nhns) = &sub_stats($fig, $cgi, $genome);
628 :    
629 :    
630 : overbeek 1.36 push(@rows,$cgi->td([$genome, $fig->is_complete($genome)?"Yes":"No",
631 : disz 1.35 $name, $size, $number_contigs, $cds,
632 : overbeek 1.38 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub> $nhs</a>",
633 :     " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub> $nhns</a>",
634 : disz 1.37 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub> $hs</a>",
635 : overbeek 1.38 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub> $hns</a>",
636 : disz 1.35 $rnas, $tax]));
637 :    
638 :    
639 :     # push(@$html,join("\t",($genome,$fig->is_complete($genome),&get_basic_stats($fig,$genome))) . "\n");
640 :     }
641 : overbeek 1.8 }
642 : disz 1.35 if ($nmpdr) {
643 :     $title = "NMPDR Genome Statistics";
644 :     } else {
645 :     $title = "Genome Statistics";
646 :     }
647 :     push(@$html,$cgi->table({-border=>undef, -width=>'100%'},
648 :     $cgi->caption($cgi->h1($title)),
649 :     $cgi->Tr(\@rows)
650 :     ));
651 :     #push(@$html,"</pre>\n");
652 : overbeek 1.8 }
653 :    
654 :    
655 : overbeek 1.9 sub subsys_summary {
656 :     my($fig,$cgi,$html) = @_;
657 :     my($Nsubs,$genome,$sub,$role,$peg,$genome_instances,%genomes_in_use,$peg_instances,%pegs_in_use);
658 :     foreach $sub ($fig->all_subsystems)
659 :     {
660 :     $Nsubs++;
661 :     foreach $genome (map { $_->[0] } @{$fig->subsystem_genomes($sub)})
662 :     {
663 :     $genome_instances++;
664 :     $genomes_in_use{$genome}++;
665 :     foreach $role ($fig->subsystem_to_roles($sub))
666 :     {
667 :     foreach $peg ($fig->pegs_in_subsystem_cell($sub,$genome,$role))
668 :     {
669 :     $peg_instances++;
670 :     $pegs_in_use{$peg}++;
671 :     }
672 :     }
673 :     }
674 :     }
675 :     my $Ngenomes = scalar keys(%genomes_in_use);
676 :     my $Npegs = scalar keys(%pegs_in_use);
677 :     my $g_in_sub = int($genome_instances / $Nsubs);
678 :     my $p_in_sub = int($peg_instances / $Nsubs);
679 :     push(@$html,$cgi->h1('Subsystem Summary'));
680 :     push(@$html,$cgi->br,
681 :     "<b>Number Subsystems:</b> $Nsubs",$cgi->br,
682 :     "<b>Genomes in Subsystems:</b> $Ngenomes",$cgi->br,
683 :     "<b>PEGs in Subsystems:</b> $Npegs",$cgi->br,
684 :     "<b>Avg genomes per subsystem:</b> $g_in_sub",$cgi->br,
685 :     "<b>Avg PEGs per subsystem:</b> $p_in_sub",$cgi->br
686 :     );
687 :     return
688 :    
689 :     }
690 : redwards 1.10
691 : redwards 1.14 sub kv_peg_stats {
692 :     my ($fig, $cgi, $html, $genome)=@_;
693 :    
694 :     #RAE Added the coverage of each genome with different attributes for the PEGs to find the number of genes that are in pirsf, etc
695 :     push(@$html, "\n<div class=\"pegattributes\">\n<p><h2>PEG Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
696 : overbeek 1.32
697 :     # DISABLED ATTRIBUTES
698 : overbeek 1.41 #my $pegtags;
699 :     #push(@$html, "Sorry attributes are not working\n");
700 : overbeek 1.32
701 : overbeek 1.41 my $count;
702 :     foreach my $res ($fig->get_peg_keys_for_genome($genome))
703 : redwards 1.14 {
704 : overbeek 1.41 $count->{$res->[1]}++;
705 : redwards 1.14 }
706 : overbeek 1.41
707 :    
708 :     push(@$html,
709 :     "<div class='tags'>",
710 :     (map {"PEGS with attribute: &nbsp; $_ : ".$count->{$_}."<br />\n"} sort {$count->{$b} <=> $count->{$a}} keys %$count),
711 :     "</div>\n",
712 :     );
713 : redwards 1.14 }
714 :    
715 : redwards 1.10 sub kv_stats {
716 :     my ($fig, $cgi, $html, $genome, $edit)=@_;
717 :    
718 :     # RAE Added tables for key value pairs for an organism, and allow you to edit them
719 :     # figure out kv's for the organism, and make a table with them
720 :    
721 :     # if the optional edit boolean is set and a user is supplied, we will make a table where you can edit the KV pairs
722 :     # else we will just make a blank table
723 :    
724 : redwards 1.12 # prepare the html so we can add form fields here
725 :     push(@$html, "\n<div class=\"attributes\">\n<p><h2>Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
726 :     if ($edit) {push(@$html, $cgi->start_form(-action=>"genome_statistics.cgi"))}
727 :    
728 :    
729 : redwards 1.10 my $tab=[];
730 :     my $user=$cgi->param('user');
731 :     my $col_hdrs=["Attribute", "Value"];
732 : redwards 1.11 if ($user && $edit) {$col_hdrs=["Attribute", "Value", "URL"]}
733 : redwards 1.10
734 :     my $known;
735 : overbeek 1.32 # DISABLED ATTRIBUTES
736 : overbeek 1.41 # to disable attributes uncomment the two next lines and comment out the foreach my $key line
737 :     #if (0) {
738 :     # my $key; # remove this if reenabling attributes
739 :     foreach my $key (sort {$a->[1] cmp $b->[1]} $fig->get_attributes($genome)) {
740 : redwards 1.13 $known->{$key->[1]}=1;
741 : redwards 1.10 if ($user && $edit) {
742 :     push @$tab,
743 :     [
744 : redwards 1.13 $key->[1],
745 :     $cgi->textfield(-name=>"value.".$key->[1], -default=>$key->[2], -size=>50),
746 :     $cgi->textfield(-name=>"url.".$key->[1], -default=>$key->[3], -size=>50),
747 : redwards 1.10 ];
748 :     } else {
749 : redwards 1.13 if ($key->[3] && $key->[3] =~ /^http/) {$key->[2] = "<a href=\"" . $key->[3] . "\">". $key->[2] . "</a>"}
750 : redwards 1.10 push @$tab,
751 :     [
752 : redwards 1.13 $key->[1],
753 :     $key->[2],
754 : redwards 1.10 ];
755 :     }
756 :     }
757 :    
758 :    
759 :     if ($edit) {
760 :     # now we want to add some pull down menus for things that we can add. And some blank boxes too for free text entry.
761 :     # start with three of each
762 :     my $opt=$fig->get_tags("genome"); # all the tags we know about
763 :     my @options=sort {uc($a) cmp uc($b)} grep {!$known->{$_}} keys %$opt;
764 :     unshift(@options, undef); # a blank field at the start
765 :     for (my $i=1; $i<= (scalar @options + 5); $i++) {
766 :    
767 :     # we have the options, and 5 blank fields for free text entry
768 :     my $choice=$cgi->popup_menu(-name=>"key.$i", -values=>\@options);
769 :     if ($i >= scalar @options) {$choice = $cgi->textfield(-name=>"key.$i", -size=>50)}
770 :     push @$tab,
771 :     [
772 :     $choice,
773 :     $cgi->textfield(-name=>"value.$i", -size=>50),
774 :     $cgi->textfield(-name=>"url.$i", -size=>50),
775 :     ];
776 :     }
777 : redwards 1.12 # we need to know how many possibilities we have to look through later. Just pass it as a hidden, rather than counting it next time
778 :     push(@$html, $cgi->hidden(-name=>"max new keys", -value=>scalar @options + 5));
779 : redwards 1.10 }
780 :    
781 :     # now just write the html
782 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Attributes"));
783 :     if ($edit) {
784 :     push(@$html, $cgi->hidden("genome"), $cgi->hidden("user"), $cgi->hidden("request"));
785 :     push(@$html, $cgi->submit('Change'), $cgi->reset());
786 :     }
787 :     else {
788 :     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");
789 :     }
790 :     }
791 :    
792 :    
793 :     sub edit_kv_stats {
794 :     my ($fig, $cgi, $html, $genome)=@_;
795 : overbeek 1.32 # DISABLED ATTRIBUTES
796 : overbeek 1.41 #return;
797 : overbeek 1.32
798 : redwards 1.10 if ($cgi->param("Change")) {
799 :     # we have changed the values
800 :     # get the old kv pairs so we can see what has changed
801 :     my $changed; my $deleted;
802 :     foreach my $key ($fig->get_attributes($genome)) {
803 : redwards 1.13 if (!$cgi->param('value.'.$key->[1]) && !$cgi->param('url.'.$key->[1])) {
804 :     $fig->delete_attribute($genome, $key->[1]);
805 : redwards 1.10 push @$key, ["deleted", "td colspan=2 style=\"text-align: center\""];
806 :     push @$deleted, $key;
807 :     }
808 : redwards 1.13 elsif (($cgi->param('value.'.$key->[1]) ne $key->[2]) || ($cgi->param('url.'.$key->[1]) ne $key->[3])) {
809 :     $fig->change_attribute($genome, $key->[1], $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]));
810 :     push @$key, $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]);
811 : redwards 1.10 push @$changed, $key;
812 :     }
813 :     }
814 :    
815 :     my $added;
816 : redwards 1.12 for (my $i=0; $i <= $cgi->param("max new keys"); $i++) {
817 : redwards 1.10 if ($cgi->param("key.$i")) {
818 :     $fig->add_attribute($genome, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"));
819 :     push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
820 :     }
821 :     }
822 :    
823 :     # now all we have to do is create a table to report what we have done.
824 :     my $tab=[];
825 :     push (@$html, "<div class=\"altered\"><p><h2>Attributes Altered for ", $fig->genus_species($genome), " ($genome)</h2></p>");
826 :     my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
827 :     if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
828 :     if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
829 :     if ($added) {push @$tab, [["<strong>Added Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}
830 :    
831 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Changed Data"));
832 :     }
833 :     else {
834 :     return kv_stats($fig, $cgi, $html, $genome, 1);
835 :     }
836 :     }
837 :    
838 : overbeek 1.23 sub model_for_genome {
839 :     my($genome) = @_;
840 :    
841 :     return -s "$FIG_Config::global/Models/$genome";
842 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3