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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3