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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3