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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.41 - (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 :     "<b>Taxonomy:</b> $taxonomy", $cgi->br, "\n";
175 :     push @$html, project_description( $genome );
176 : overbeek 1.3 return
177 :     }
178 : overbeek 1.4
179 : golsen 1.16
180 :     sub project_description {
181 :     ( my $genome = shift @_ ) or return ();
182 :     -d $FIG_Config::organisms && -d "$FIG_Config::organisms/$genome"
183 :     && -f "$FIG_Config::organisms/$genome/PROJECT"
184 :     || return ();
185 :     open( PROJECT, "<$FIG_Config::organisms/$genome/PROJECT" ) || return ();
186 :     my @project = <PROJECT>;
187 :     close PROJECT;
188 :     return ( "<b>Project description:</b>\n<pre>",
189 :     ( map { " " . $_ } @project ),
190 :     "</pre>\n"
191 :     );
192 :     }
193 :    
194 :    
195 : overbeek 1.4 sub commify {
196 :     my($n) = @_;
197 :     my(@n) = ();
198 :     my($i);
199 :    
200 :     for ($i = (length($n) - 3); ($i > 0); $i -= 3)
201 :     {
202 :     unshift(@n,",",substr($n,$i,3));
203 :     }
204 :     unshift(@n,substr($n,0,$i+3));
205 :     return join("",@n);
206 :     }
207 :    
208 :     sub assignment_stats {
209 :     my($fig,$cgi,$html,$genome) = @_;
210 :    
211 : overbeek 1.5 my $rdbH = $fig->db_handle;
212 :    
213 :     my $hypo_sub = 0;
214 :     my $hypo_nosub = 0;
215 :     my $nothypo_sub = 0;
216 :     my $nothypo_nosub = 0;
217 :    
218 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
219 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
220 :     my $in = keys(%in);
221 : overbeek 1.5
222 : overbeek 1.34 my %sscount = map { $_->[0] => 1 } @$subsystem_data;
223 :     my $nss=scalar(keys(%sscount));
224 :    
225 : overbeek 1.6 foreach $_ (@$assignments_data)
226 : overbeek 1.5 {
227 :     my($peg,$func) = @$_;
228 :     my $is_hypo = &FIG::hypo($func);
229 :    
230 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
231 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
232 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
233 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
234 :     }
235 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
236 : efrank 1.30
237 :     my ($fracHS, $fracNHS, $fracHNS, $fracNHNS);
238 :    
239 :     if ($tot == 0) {
240 : overbeek 1.31 $fracHS = sprintf "%4.2f", 0.0;
241 :     $fracNHS = sprintf "%4.2f", 0.0;
242 :     $fracHNS = sprintf "%4.2f", 0.0;
243 : efrank 1.30 my $fracNHNS = sprintf "%4.2f", 0.0;
244 :     } else {
245 : overbeek 1.31 $fracHS = sprintf "%4.2f", $hypo_sub / $tot;
246 :     $fracNHS = sprintf "%4.2f", $nothypo_sub / $tot;
247 :     $fracHNS = sprintf "%4.2f", $hypo_nosub / $tot;
248 :     $fracNHNS = sprintf "%4.2f", $nothypo_nosub / $tot;
249 : efrank 1.30 }
250 :    
251 : overbeek 1.6 my $user = $cgi->param('user');
252 : overbeek 1.5
253 : golsen 1.16 push @$html, "<table>\n",
254 :     " <tr>\n",
255 : overbeek 1.34 " <th align=left>Number of subsystems:</th>\n",
256 :     " <td align=right><a href=\"subsys_vectors.cgi?korgs=$genome&allss=1\">$nss</a></td>\n",
257 :     " </tr>\n",
258 :     " <tr>\n",
259 : golsen 1.16 " <th align=left>PEGs with hypothetical functions and in subsystem:</th>\n",
260 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub>$hypo_sub ($fracHS)</a></td>\n",
261 :     " </tr>\n",
262 :     " <tr>\n",
263 :     " <th align=left>PEGs with nonhypothetical functions and in subsystem:</th>\n",
264 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub>$nothypo_sub ($fracNHS)</a></td>\n",
265 :     " </tr>\n",
266 :     " <tr>\n",
267 :     " <th align=left>PEGs with hypothetical functions and not in subsystem:</th>\n",
268 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub>$hypo_nosub ($fracHNS)</a></td>\n",
269 :     " </tr>\n",
270 :     " <tr>\n",
271 :     " <th align=left>PEGs with nonhypothetical functions and not in subsystem:</th>\n",
272 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub>$nothypo_nosub ($fracNHNS)</a></td>\n",
273 :     " </tr>\n",
274 :     "</table>\n";
275 : overbeek 1.4 }
276 : disz 1.35 sub sub_stats {
277 :     my($fig,$cgi,$genome) = @_;
278 :    
279 :     my $rdbH = $fig->db_handle;
280 :    
281 :     my $hypo_sub = 0;
282 :     my $hypo_nosub = 0;
283 :     my $nothypo_sub = 0;
284 :     my $nothypo_nosub = 0;
285 :     my $fracHS;
286 :     my $fracNHS;
287 :     my $fracHNS;
288 :     my $fracNHNS;
289 :    
290 :     my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
291 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
292 :     my $in = keys(%in);
293 :    
294 :     #print STDERR &Dumper($genome, $assignments_data, $subsystem_data);
295 :     foreach $_ (@$assignments_data)
296 :     {
297 :     my($peg,$func) = @$_;
298 :     my $is_hypo = &FIG::hypo($func);
299 :    
300 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
301 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
302 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
303 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
304 :     }
305 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
306 :    
307 :     if ($tot) {
308 :     $fracHS = sprintf "%d (%4.1f%%)", $hypo_sub, 100 * $hypo_sub / $tot;
309 :     $fracNHS = sprintf "%d (%4.1f%%)", $nothypo_sub, 100 * $nothypo_sub / $tot;
310 :     $fracHNS = sprintf "%d (%4.1f%%)", $hypo_nosub, 100 * $hypo_nosub / $tot;
311 :     $fracNHNS = sprintf "%d (%4.1f%%)", $nothypo_nosub, 100 * $nothypo_nosub / $tot;
312 :     } else {
313 :     $fracHS = 0;
314 :     $fracNHS = 0;
315 :     $fracHNS = 0;
316 :     $fracNHNS = 0;
317 :     }
318 :    
319 :     return ($fracHS, $fracHNS, $fracNHS, $fracNHNS);
320 :     }
321 : overbeek 1.4
322 : overbeek 1.5 sub handle_show_subsystems {
323 : overbeek 1.4 my($fig,$cgi,$html,$genome) = @_;
324 : overbeek 1.19 my(%in,$sub,$role,$protein,$sub_link,$tuple,$categories);
325 : overbeek 1.4
326 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
327 : overbeek 1.25 my $active = $fig->active_subsystems($genome);
328 : disz 1.35 push(@$html,$cgi->h1($genome));
329 : overbeek 1.6 foreach $_ (@$subsystem_data)
330 :     {
331 :     ($sub,$role,$protein) = @$_;
332 : overbeek 1.25 if ($active->{$sub})
333 :     {
334 :     push(@{$in{$sub}->{$role}},&HTML::fid_link($cgi,$protein,0) . ": " . scalar $fig->function_of($protein));
335 :     }
336 : overbeek 1.6 }
337 : overbeek 1.19
338 :     my @subs = sort { ($a->[0] cmp $b->[0]) or
339 :     ($a->[1] cmp $b->[1]) or
340 :     ($a->[2] cmp $b->[2]) or
341 :     ($a->[3] cmp $b->[3]) or
342 :     ($a->[4] cmp $b->[4])
343 :     }
344 :     map { $sub = $_;
345 :     $categories = $fig->subsystem_classification($sub);
346 :     $categories = ((@$categories > 0) && $categories->[0]) ? $categories : ["Misc"];
347 :     [@$categories,$sub]
348 :     }
349 :     keys(%in);
350 :    
351 : overbeek 1.20 my $last1 = "";
352 :     my $last2 = "";
353 : overbeek 1.19 foreach $tuple (@subs)
354 :     {
355 :     $sub = pop @{$tuple};
356 :     my $topic = $tuple->[0];
357 : overbeek 1.20
358 :     if ($topic ne $last1)
359 :     {
360 :     push(@$html,$cgi->h1($topic));
361 :     $last1 = $topic;
362 :     $last2 = "";
363 :     }
364 :    
365 :     $topic = $tuple->[1] ? $tuple->[1] : "";
366 :     if ($topic && ($topic ne $last2))
367 : overbeek 1.19 {
368 :     push(@$html,$cgi->h2($topic));
369 : overbeek 1.20 $last2 = $topic;
370 : overbeek 1.19 }
371 : overbeek 1.20
372 : overbeek 1.6 $sub_link = &sub_link($cgi,$sub);
373 : overbeek 1.19 push(@$html,$cgi->h3($sub_link));
374 :    
375 : overbeek 1.6 my $roles = [];
376 :     foreach $role (sort keys(%{$in{$sub}}))
377 :     {
378 :     push(@$roles,$cgi->ul($cgi->li($in{$sub}->{$role})));
379 :     }
380 :     push(@$html,$cgi->ul($cgi->li($roles)));
381 :     }
382 : overbeek 1.4 }
383 : overbeek 1.5
384 : overbeek 1.21 sub handle_show_reactions {
385 :     my($fig,$cgi,$html,$genome) = @_;
386 :     my($react_for_role,$r,%topic,%reaction,$sub,$role,$protein,$sub_link,$tuple,$categories);
387 :     my(%reactions_for_sub,%class,$reactions,$classL,$category);
388 :    
389 :     my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
390 : overbeek 1.24
391 : overbeek 1.21 foreach $_ (@$subsystem_data)
392 :     {
393 :     ($sub,$role,$protein) = @$_;
394 :     if (! defined($reactions_for_sub{$sub}))
395 :     {
396 :     my $subsystem = new Subsystem($sub,$fig,0);
397 :     $reactions = $subsystem->get_reactions;
398 :     $reactions = $reactions ? $reactions : "";
399 :     $reactions_for_sub{$sub} = $reactions;
400 :     $class{$sub} = $fig->subsystem_classification($sub);
401 :     }
402 :    
403 :     if (($reactions = $reactions_for_sub{$sub}) && ($react_for_role = $reactions->{$role}))
404 :     {
405 :     $classL = $class{$sub};
406 :     $category = ((@$classL > 0) && $classL->[0]) ? $classL->[0] : "Misc";
407 :     foreach $r (@$react_for_role)
408 :     {
409 : overbeek 1.26 if ($fig->valid_reaction_id($r))
410 :     {
411 :     $reaction{$r}->{$protein} = 1;
412 :     $topic{$category}->{$r} = 1;
413 :     }
414 : overbeek 1.21 }
415 :     }
416 :     }
417 :    
418 :     my @all = sort { $a cmp $b } keys(%topic);
419 : overbeek 1.24
420 :     if (@all == 0)
421 :     {
422 :     push(@$html, $cgi->p("No class reactions found."));
423 :     }
424 : overbeek 1.21 foreach $category (@all)
425 :     {
426 : overbeek 1.22 &show_class_react($fig,$cgi,$html,$category,[keys(%{$topic{$category}})],\%reaction);
427 : overbeek 1.21 }
428 :    
429 :     if ($_ = $topic{"Misc"})
430 :     {
431 : overbeek 1.22 &show_class_react($fig,$cgi,$html,'Misc',[keys(%$_)],\%reaction);
432 : overbeek 1.21 }
433 : overbeek 1.24 else
434 :     {
435 :     push(@$html, $cgi->p("No misc reactions found."));
436 :     }
437 :    
438 : overbeek 1.21 }
439 :    
440 :     sub show_class_react {
441 :     my($fig,$cgi,$html,$class,$for_topic,$reaction) = @_;
442 :     my($r,@pegs,$peg);
443 :    
444 :     push(@$html,$cgi->h1($class));
445 : overbeek 1.22 foreach $r (sort @$for_topic)
446 : overbeek 1.21 {
447 :     my $disp_react = $fig->displayable_reaction($r);
448 :     $disp_react =~ s/^R\d+\: //;
449 :    
450 :     my $rstring = &HTML::reaction_link($r) . ": $disp_react";
451 :     push(@$html,$cgi->h2($rstring),"\n");
452 :     @pegs = sort { &FIG::by_fig_id($a,$b) } keys(%{$reaction->{$r}});
453 :     push(@$html,"<ul>\n");
454 :     foreach $peg (@pegs)
455 :     {
456 :     push(@$html,"<li>" . &HTML::fid_link($cgi,$peg) . " " . scalar $fig->function_of($peg) . "\n");
457 :     }
458 :     push(@$html,"</ul>\n");
459 :     }
460 :     }
461 :    
462 : overbeek 1.5 sub handle_hypo_sub {
463 :     my($fig,$cgi,$html,$genome) = @_;
464 :    
465 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
466 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
467 :     my $col_hdrs = ["PEG","Function","Subsystem"];
468 :     my $tab = [];
469 :     foreach $_ (@$assignments_data)
470 :     {
471 :     my($peg,$func) = @$_;
472 :     if (&FIG::hypo($func) && ($subs{$peg}))
473 :     {
474 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
475 :     }
476 :     }
477 :     $_ = @$tab;
478 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs in Subsystems"));
479 : overbeek 1.5 }
480 :    
481 :     sub handle_hypo_nosub {
482 :     my($fig,$cgi,$html,$genome) = @_;
483 :    
484 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
485 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
486 :     my $col_hdrs = ["PEG","Function"];
487 :     my $tab = [];
488 :     foreach $_ (@$assignments_data)
489 :     {
490 :     my($peg,$func) = @$_;
491 :     if (&FIG::hypo($func) && (! $subs{$peg}))
492 :     {
493 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
494 :     }
495 :     }
496 :     $_ = @$tab;
497 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs NOT in Subsystems"));
498 : overbeek 1.5 }
499 :    
500 :     sub handle_nothypo_sub {
501 :     my($fig,$cgi,$html,$genome) = @_;
502 :    
503 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
504 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
505 :     my $col_hdrs = ["PEG","Function","Subsystem"];
506 :     my $tab = [];
507 :     foreach $_ (@$assignments_data)
508 :     {
509 :     my($peg,$func) = @$_;
510 :     if ((! &FIG::hypo($func)) && ($subs{$peg}))
511 :     {
512 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
513 :     }
514 :     }
515 :     $_ = @$tab;
516 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs in Subsystems"));
517 : overbeek 1.5 }
518 :    
519 :     sub handle_nothypo_nosub {
520 :     my($fig,$cgi,$html,$genome) = @_;
521 :    
522 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
523 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
524 :     my $col_hdrs = ["PEG","Function"];
525 :     my $tab = [];
526 :     foreach $_ (@$assignments_data)
527 :     {
528 :     my($peg,$func) = @$_;
529 :     if ((! &FIG::hypo($func)) && (! $subs{$peg}))
530 :     {
531 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
532 :     }
533 :     }
534 :     $_ = @$tab;
535 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs NOT in Subsystems"));
536 : overbeek 1.5 }
537 :    
538 : overbeek 1.6 sub get_data {
539 :     my($fig,$cgi,$genome) = @_;
540 :    
541 :     my $rdbH = $fig->db_handle;
542 : olson 1.27
543 :     #
544 :     # For now need to try with variant first, then back off to not using variant
545 :     # if we hit a database error.
546 :     #
547 :    
548 :     my $subsystem_data;
549 :    
550 :     {
551 :     my $dbh = $rdbH->{_dbh};
552 :     local $dbh->{RaiseError} = 1;
553 :     local $dbh->{PrintError} = 0;
554 :    
555 :     eval {
556 :     $subsystem_data = $rdbH->SQL(qq(SELECT DISTINCT subsystem,role,protein
557 :     FROM subsystem_index
558 :     WHERE (protein like 'fig\|$genome.peg.%' AND
559 :     variant != '-1')
560 :     ));
561 :     };
562 :     }
563 :     if ($@ =~ /variant/)
564 :     {
565 :     $subsystem_data = $rdbH->SQL(qq(SELECT DISTINCT subsystem,role,protein
566 :     FROM subsystem_index
567 :     WHERE (protein like 'fig\|$genome.peg.%')
568 :     ));
569 :     }
570 : 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' )");
571 :    
572 :     return ($subsystem_data,$assignment_data);
573 :     }
574 :    
575 :     sub sub_link {
576 :     my($cgi,$sub) = @_;
577 :    
578 : overbeek 1.29 my $genome = $cgi->param('genome');
579 : overbeek 1.6 my $user = $cgi->param('user');
580 : overbeek 1.19 $user = defined($user) ? $user : "";
581 : 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>";
582 : overbeek 1.19
583 : overbeek 1.6 return $sub_link;
584 :     }
585 : overbeek 1.8
586 :     sub get_basic_stats {
587 :     my($fig,$genome) = @_;
588 :    
589 :     my $rdbH = $fig->db_handle;
590 :     my $relational_db_response = $rdbH->SQL("SELECT gname,szdna,pegs,rnas,taxonomy FROM genome WHERE genome = '$genome'");
591 :     my($gname,$szdna,$pegs,$rnas,$taxonomy) = @{$relational_db_response->[0]};
592 :     my $szdna = &commify($szdna);
593 :     my $num_contigs = scalar $fig->all_contigs($genome);
594 :     return ($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy);
595 :     }
596 :    
597 :     sub table_of_genomes {
598 :     my($fig,$cgi,$html) = @_;
599 :     my(@genomes);
600 :    
601 : disz 1.35 # push(@$html,"<pre>\n");
602 : overbeek 1.8 if ($cgi->param('complete'))
603 :     {
604 : disz 1.39 @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes("complete"));
605 : overbeek 1.8 }
606 :     else
607 :     {
608 : disz 1.39 @genomes = $fig->sort_genomes_by_taxonomy($fig->genomes);
609 : overbeek 1.8 }
610 :    
611 : disz 1.35 my (@rows, @headings);
612 : overbeek 1.8 my $genome;
613 : disz 1.35 #push(@$html,join("\t","Genome ID","Complete","Genome Name","Size (bp)","Number Contigs","CDSs","RNAs","Taxonomy") . "\n");
614 :    
615 :     @headings = ("Genome ID","Complete","Genome Name",
616 : 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");
617 : disz 1.35 @rows = $cgi->th(\@headings);
618 :    
619 :     my $title;
620 :    
621 : disz 1.37 my $user = $cgi->param('user');
622 : overbeek 1.8 foreach $genome (@genomes)
623 :     {
624 : disz 1.35 if (! $nmpdr || -f "$FIG_Config::organisms/$genome/NMPDR") {
625 :     my ($name, $size, $number_contigs, $cds, $rnas, $tax) = &get_basic_stats($fig, $genome);
626 :     my ($hs, $hns, $nhs, $nhns) = &sub_stats($fig, $cgi, $genome);
627 :    
628 :    
629 : overbeek 1.36 push(@rows,$cgi->td([$genome, $fig->is_complete($genome)?"Yes":"No",
630 : disz 1.35 $name, $size, $number_contigs, $cds,
631 : overbeek 1.38 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub> $nhs</a>",
632 :     " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub> $nhns</a>",
633 : disz 1.37 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub> $hs</a>",
634 : overbeek 1.38 " <a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub> $hns</a>",
635 : disz 1.35 $rnas, $tax]));
636 :    
637 :    
638 :     # push(@$html,join("\t",($genome,$fig->is_complete($genome),&get_basic_stats($fig,$genome))) . "\n");
639 :     }
640 : overbeek 1.8 }
641 : disz 1.35 if ($nmpdr) {
642 :     $title = "NMPDR Genome Statistics";
643 :     } else {
644 :     $title = "Genome Statistics";
645 :     }
646 :     push(@$html,$cgi->table({-border=>undef, -width=>'100%'},
647 :     $cgi->caption($cgi->h1($title)),
648 :     $cgi->Tr(\@rows)
649 :     ));
650 :     #push(@$html,"</pre>\n");
651 : overbeek 1.8 }
652 :    
653 :    
654 : overbeek 1.9 sub subsys_summary {
655 :     my($fig,$cgi,$html) = @_;
656 :     my($Nsubs,$genome,$sub,$role,$peg,$genome_instances,%genomes_in_use,$peg_instances,%pegs_in_use);
657 :     foreach $sub ($fig->all_subsystems)
658 :     {
659 :     $Nsubs++;
660 :     foreach $genome (map { $_->[0] } @{$fig->subsystem_genomes($sub)})
661 :     {
662 :     $genome_instances++;
663 :     $genomes_in_use{$genome}++;
664 :     foreach $role ($fig->subsystem_to_roles($sub))
665 :     {
666 :     foreach $peg ($fig->pegs_in_subsystem_cell($sub,$genome,$role))
667 :     {
668 :     $peg_instances++;
669 :     $pegs_in_use{$peg}++;
670 :     }
671 :     }
672 :     }
673 :     }
674 :     my $Ngenomes = scalar keys(%genomes_in_use);
675 :     my $Npegs = scalar keys(%pegs_in_use);
676 :     my $g_in_sub = int($genome_instances / $Nsubs);
677 :     my $p_in_sub = int($peg_instances / $Nsubs);
678 :     push(@$html,$cgi->h1('Subsystem Summary'));
679 :     push(@$html,$cgi->br,
680 :     "<b>Number Subsystems:</b> $Nsubs",$cgi->br,
681 :     "<b>Genomes in Subsystems:</b> $Ngenomes",$cgi->br,
682 :     "<b>PEGs in Subsystems:</b> $Npegs",$cgi->br,
683 :     "<b>Avg genomes per subsystem:</b> $g_in_sub",$cgi->br,
684 :     "<b>Avg PEGs per subsystem:</b> $p_in_sub",$cgi->br
685 :     );
686 :     return
687 :    
688 :     }
689 : redwards 1.10
690 : redwards 1.14 sub kv_peg_stats {
691 :     my ($fig, $cgi, $html, $genome)=@_;
692 :    
693 :     #RAE Added the coverage of each genome with different attributes for the PEGs to find the number of genes that are in pirsf, etc
694 :     push(@$html, "\n<div class=\"pegattributes\">\n<p><h2>PEG Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
695 : overbeek 1.32
696 :     # DISABLED ATTRIBUTES
697 : overbeek 1.41 #my $pegtags;
698 :     #push(@$html, "Sorry attributes are not working\n");
699 : overbeek 1.32
700 : overbeek 1.41 my $count;
701 :     foreach my $res ($fig->get_peg_keys_for_genome($genome))
702 : redwards 1.14 {
703 : overbeek 1.41 $count->{$res->[1]}++;
704 : redwards 1.14 }
705 : overbeek 1.41
706 :    
707 :     push(@$html,
708 :     "<div class='tags'>",
709 :     (map {"PEGS with attribute: &nbsp; $_ : ".$count->{$_}."<br />\n"} sort {$count->{$b} <=> $count->{$a}} keys %$count),
710 :     "</div>\n",
711 :     );
712 : redwards 1.14 }
713 :    
714 : redwards 1.10 sub kv_stats {
715 :     my ($fig, $cgi, $html, $genome, $edit)=@_;
716 :    
717 :     # RAE Added tables for key value pairs for an organism, and allow you to edit them
718 :     # figure out kv's for the organism, and make a table with them
719 :    
720 :     # if the optional edit boolean is set and a user is supplied, we will make a table where you can edit the KV pairs
721 :     # else we will just make a blank table
722 :    
723 : redwards 1.12 # prepare the html so we can add form fields here
724 :     push(@$html, "\n<div class=\"attributes\">\n<p><h2>Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
725 :     if ($edit) {push(@$html, $cgi->start_form(-action=>"genome_statistics.cgi"))}
726 :    
727 :    
728 : redwards 1.10 my $tab=[];
729 :     my $user=$cgi->param('user');
730 :     my $col_hdrs=["Attribute", "Value"];
731 : redwards 1.11 if ($user && $edit) {$col_hdrs=["Attribute", "Value", "URL"]}
732 : redwards 1.10
733 :     my $known;
734 : overbeek 1.32 # DISABLED ATTRIBUTES
735 : overbeek 1.41 # to disable attributes uncomment the two next lines and comment out the foreach my $key line
736 :     #if (0) {
737 :     # my $key; # remove this if reenabling attributes
738 :     foreach my $key (sort {$a->[1] cmp $b->[1]} $fig->get_attributes($genome)) {
739 : redwards 1.13 $known->{$key->[1]}=1;
740 : redwards 1.10 if ($user && $edit) {
741 :     push @$tab,
742 :     [
743 : redwards 1.13 $key->[1],
744 :     $cgi->textfield(-name=>"value.".$key->[1], -default=>$key->[2], -size=>50),
745 :     $cgi->textfield(-name=>"url.".$key->[1], -default=>$key->[3], -size=>50),
746 : redwards 1.10 ];
747 :     } else {
748 : redwards 1.13 if ($key->[3] && $key->[3] =~ /^http/) {$key->[2] = "<a href=\"" . $key->[3] . "\">". $key->[2] . "</a>"}
749 : redwards 1.10 push @$tab,
750 :     [
751 : redwards 1.13 $key->[1],
752 :     $key->[2],
753 : redwards 1.10 ];
754 :     }
755 :     }
756 :    
757 :    
758 :     if ($edit) {
759 :     # now we want to add some pull down menus for things that we can add. And some blank boxes too for free text entry.
760 :     # start with three of each
761 :     my $opt=$fig->get_tags("genome"); # all the tags we know about
762 :     my @options=sort {uc($a) cmp uc($b)} grep {!$known->{$_}} keys %$opt;
763 :     unshift(@options, undef); # a blank field at the start
764 :     for (my $i=1; $i<= (scalar @options + 5); $i++) {
765 :    
766 :     # we have the options, and 5 blank fields for free text entry
767 :     my $choice=$cgi->popup_menu(-name=>"key.$i", -values=>\@options);
768 :     if ($i >= scalar @options) {$choice = $cgi->textfield(-name=>"key.$i", -size=>50)}
769 :     push @$tab,
770 :     [
771 :     $choice,
772 :     $cgi->textfield(-name=>"value.$i", -size=>50),
773 :     $cgi->textfield(-name=>"url.$i", -size=>50),
774 :     ];
775 :     }
776 : 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
777 :     push(@$html, $cgi->hidden(-name=>"max new keys", -value=>scalar @options + 5));
778 : redwards 1.10 }
779 :    
780 :     # now just write the html
781 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Attributes"));
782 :     if ($edit) {
783 :     push(@$html, $cgi->hidden("genome"), $cgi->hidden("user"), $cgi->hidden("request"));
784 :     push(@$html, $cgi->submit('Change'), $cgi->reset());
785 :     }
786 :     else {
787 :     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");
788 :     }
789 :     }
790 :    
791 :    
792 :     sub edit_kv_stats {
793 :     my ($fig, $cgi, $html, $genome)=@_;
794 : overbeek 1.32 # DISABLED ATTRIBUTES
795 : overbeek 1.41 #return;
796 : overbeek 1.32
797 : redwards 1.10 if ($cgi->param("Change")) {
798 :     # we have changed the values
799 :     # get the old kv pairs so we can see what has changed
800 :     my $changed; my $deleted;
801 :     foreach my $key ($fig->get_attributes($genome)) {
802 : redwards 1.13 if (!$cgi->param('value.'.$key->[1]) && !$cgi->param('url.'.$key->[1])) {
803 :     $fig->delete_attribute($genome, $key->[1]);
804 : redwards 1.10 push @$key, ["deleted", "td colspan=2 style=\"text-align: center\""];
805 :     push @$deleted, $key;
806 :     }
807 : redwards 1.13 elsif (($cgi->param('value.'.$key->[1]) ne $key->[2]) || ($cgi->param('url.'.$key->[1]) ne $key->[3])) {
808 :     $fig->change_attribute($genome, $key->[1], $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]));
809 :     push @$key, $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]);
810 : redwards 1.10 push @$changed, $key;
811 :     }
812 :     }
813 :    
814 :     my $added;
815 : redwards 1.12 for (my $i=0; $i <= $cgi->param("max new keys"); $i++) {
816 : redwards 1.10 if ($cgi->param("key.$i")) {
817 :     $fig->add_attribute($genome, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"));
818 :     push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
819 :     }
820 :     }
821 :    
822 :     # now all we have to do is create a table to report what we have done.
823 :     my $tab=[];
824 :     push (@$html, "<div class=\"altered\"><p><h2>Attributes Altered for ", $fig->genus_species($genome), " ($genome)</h2></p>");
825 :     my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
826 :     if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
827 :     if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
828 :     if ($added) {push @$tab, [["<strong>Added Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}
829 :    
830 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Changed Data"));
831 :     }
832 :     else {
833 :     return kv_stats($fig, $cgi, $html, $genome, 1);
834 :     }
835 :     }
836 :    
837 : overbeek 1.23 sub model_for_genome {
838 :     my($genome) = @_;
839 :    
840 :     return -s "$FIG_Config::global/Models/$genome";
841 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3