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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3