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

Annotation of /FigWebServices/genome_statistics.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.18 - (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 : overbeek 1.18 use CGI::Carp qw(fatalsToBrowser);
10 : overbeek 1.1 use CGI;
11 :     my $cgi = new CGI;
12 : overbeek 1.18 use raelib;
13 :    
14 : overbeek 1.1
15 : overbeek 1.2 if (0)
16 : overbeek 1.1 {
17 :     my $VAR1;
18 :     eval(join("",`cat /tmp/statistics_parms`));
19 :     $cgi = $VAR1;
20 :     # print STDERR &Dumper($cgi);
21 :     }
22 :    
23 :     if (0)
24 :     {
25 :     print $cgi->header;
26 :     my @params = $cgi->param;
27 :     print "<pre>\n";
28 :     foreach $_ (@params)
29 :     {
30 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
31 :     }
32 :    
33 :     if (0)
34 :     {
35 :     if (open(TMP,">/tmp/statistics_parms"))
36 :     {
37 :     print TMP &Dumper($cgi);
38 :     close(TMP);
39 :     }
40 :     }
41 :     exit;
42 :     }
43 :    
44 :     my $html = [];
45 : olson 1.7 unshift @$html, "<TITLE>The SEED Statistics Page</TITLE>\n";
46 : overbeek 1.1
47 : overbeek 1.8 my @genomes = $cgi->param('genome');
48 :     my $request = $cgi->param('request');
49 : overbeek 1.18 my $user = $cgi->param('user');
50 : overbeek 1.9
51 :     if ($request eq "subsystems_summary")
52 :     {
53 :     &subsys_summary($fig,$cgi,$html);
54 :     }
55 : redwards 1.17 elsif ($request eq "subsystems_by_homology")
56 :     {
57 :     &subsys_homol($fig,$cgi,$html,$cgi->param('genome'));
58 :     }
59 : redwards 1.10 elsif ($request eq "edit_kv_stats") {
60 :     &edit_kv_stats($fig,$cgi,$html, $cgi->param('genome'));
61 :     }
62 : overbeek 1.9 elsif ((@genomes == 0) && (! $request))
63 : overbeek 1.8 {
64 :     &table_of_genomes($fig,$cgi,$html);
65 :     }
66 :     elsif (! $request)
67 :     {
68 :     my $genome;
69 :     foreach $genome (@genomes)
70 :     {
71 :     &basic_stats($fig,$cgi,$html,$genome);
72 :     push(@$html,$cgi->hr);
73 :     &assignment_stats($fig,$cgi,$html,$genome);
74 :     push(@$html,$cgi->hr);
75 : redwards 1.14 &kv_peg_stats($fig, $cgi, $html, $genome);
76 :     push(@$html,$cgi->hr);
77 : redwards 1.10 &kv_stats($fig, $cgi, $html, $genome);
78 : overbeek 1.18 push(@$html,"<p><a href=./genome_statistics.cgi?genome=$genome&request=show_subsystems&user=$user>Show Subsystems</a></p>");
79 :     push(@$html,"<p><a href=./genome_statistics.cgi?genome=$genome&request=subsystems_by_homology&user=$user>Count Proteins in Subsystems</a></p>");
80 : overbeek 1.8 push(@$html,$cgi->br);
81 :     }
82 :     }
83 :     elsif (@genomes == 0)
84 : overbeek 1.1 {
85 : overbeek 1.8 push(@$html,"<h1>Sorry, you need to specify at least one valid genome</h1>\n");
86 : overbeek 1.1 }
87 : overbeek 1.3 else
88 :     {
89 : golsen 1.16 if ($request eq "hypo_sub") { &handle_hypo_sub($fig,$cgi,$html,$genomes[0]) }
90 : overbeek 1.8 elsif ($request eq "hypo_nosub") { &handle_hypo_nosub($fig,$cgi,$html,$genomes[0]) }
91 :     elsif ($request eq "nothypo_sub") { &handle_nothypo_sub($fig,$cgi,$html,$genomes[0]) }
92 :     elsif ($request eq "nothypo_nosub") { &handle_nothypo_nosub($fig,$cgi,$html,$genomes[0]) }
93 :     elsif ($request eq "show_subsystems") { &handle_show_subsystems($fig,$cgi,$html,$genomes[0]) }
94 :     else
95 :     {
96 :     push(@$html,$cgi->h1("Invalid request: $request"));
97 :     }
98 : overbeek 1.3 }
99 : overbeek 1.1 &HTML::show_page($cgi,$html);
100 :     exit;
101 : overbeek 1.3
102 : golsen 1.16
103 :     # Only subroutines below
104 :    
105 :    
106 : overbeek 1.3 sub basic_stats {
107 :     my($fig,$cgi,$html,$genome) = @_;
108 :    
109 : overbeek 1.8 my($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy) = &get_basic_stats($fig,$genome);
110 : golsen 1.16 push @$html, $cgi->h1('Basic Statistics'), "\n",
111 :     "<b>Genome ID:</b> $genome", $cgi->br, "\n",
112 :     "<b>Name:</b> $gname", $cgi->br, "\n",
113 :     "<b>Size (bp):</b> $szdna", $cgi->br, "\n",
114 :     "<b>Number contigs:</b> $num_contigs", $cgi->br, "\n",
115 :     "<b>Number CDSs:</b> $pegs", $cgi->br, "\n",
116 :     "<b>Number rnas:</b> $rnas", $cgi->br, "\n",
117 :     "<b>Taxonomy:</b> $taxonomy", $cgi->br, "\n";
118 :     push @$html, project_description( $genome );
119 : overbeek 1.3 return
120 :     }
121 : overbeek 1.4
122 : golsen 1.16
123 :     sub project_description {
124 :     ( my $genome = shift @_ ) or return ();
125 :     -d $FIG_Config::organisms && -d "$FIG_Config::organisms/$genome"
126 :     && -f "$FIG_Config::organisms/$genome/PROJECT"
127 :     || return ();
128 :     open( PROJECT, "<$FIG_Config::organisms/$genome/PROJECT" ) || return ();
129 :     my @project = <PROJECT>;
130 :     close PROJECT;
131 :     return ( "<b>Project description:</b>\n<pre>",
132 :     ( map { " " . $_ } @project ),
133 :     "</pre>\n"
134 :     );
135 :     }
136 :    
137 :    
138 : overbeek 1.4 sub commify {
139 :     my($n) = @_;
140 :     my(@n) = ();
141 :     my($i);
142 :    
143 :     for ($i = (length($n) - 3); ($i > 0); $i -= 3)
144 :     {
145 :     unshift(@n,",",substr($n,$i,3));
146 :     }
147 :     unshift(@n,substr($n,0,$i+3));
148 :     return join("",@n);
149 :     }
150 :    
151 :     sub assignment_stats {
152 :     my($fig,$cgi,$html,$genome) = @_;
153 :    
154 : overbeek 1.5 my $rdbH = $fig->db_handle;
155 :    
156 :     my $hypo_sub = 0;
157 :     my $hypo_nosub = 0;
158 :     my $nothypo_sub = 0;
159 :     my $nothypo_nosub = 0;
160 :    
161 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
162 :     my %in = map { $_->[2] => 1 } @$subsystem_data;
163 :     my $in = keys(%in);
164 : overbeek 1.5
165 : overbeek 1.6 foreach $_ (@$assignments_data)
166 : overbeek 1.5 {
167 :     my($peg,$func) = @$_;
168 :     my $is_hypo = &FIG::hypo($func);
169 :    
170 :     if ($is_hypo && $in{$peg}) { $hypo_sub++ }
171 :     elsif ($is_hypo && ! $in{$peg}) { $hypo_nosub++ }
172 :     elsif ((! $is_hypo) && (! $in{$peg})) { $nothypo_nosub++ }
173 :     elsif ((! $is_hypo) && $in{$peg}) { $nothypo_sub++ }
174 :     }
175 :     my $tot = $hypo_sub + $nothypo_sub + $hypo_nosub + $nothypo_nosub;
176 :     my $fracHS = sprintf "%4.2f", $hypo_sub / $tot;
177 :     my $fracNHS = sprintf "%4.2f", $nothypo_sub / $tot;
178 :     my $fracHNS = sprintf "%4.2f", $hypo_nosub / $tot;
179 :     my $fracNHNS = sprintf "%4.2f", $nothypo_nosub / $tot;
180 : overbeek 1.6
181 :     my $user = $cgi->param('user');
182 : overbeek 1.5
183 : golsen 1.16 push @$html, "<table>\n",
184 :     " <tr>\n",
185 :     " <th align=left>PEGs with hypothetical functions and in subsystem:</th>\n",
186 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_sub>$hypo_sub ($fracHS)</a></td>\n",
187 :     " </tr>\n",
188 :     " <tr>\n",
189 :     " <th align=left>PEGs with nonhypothetical functions and in subsystem:</th>\n",
190 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_sub>$nothypo_sub ($fracNHS)</a></td>\n",
191 :     " </tr>\n",
192 :     " <tr>\n",
193 :     " <th align=left>PEGs with hypothetical functions and not in subsystem:</th>\n",
194 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=hypo_nosub>$hypo_nosub ($fracHNS)</a></td>\n",
195 :     " </tr>\n",
196 :     " <tr>\n",
197 :     " <th align=left>PEGs with nonhypothetical functions and not in subsystem:</th>\n",
198 :     " <td align=right><a href=./genome_statistics.cgi?user=$user&genome=$genome&request=nothypo_nosub>$nothypo_nosub ($fracNHNS)</a></td>\n",
199 :     " </tr>\n",
200 :     "</table>\n";
201 : overbeek 1.4 }
202 :    
203 : overbeek 1.5 sub handle_show_subsystems {
204 : overbeek 1.4 my($fig,$cgi,$html,$genome) = @_;
205 : overbeek 1.6 my(%in,$sub,$role,$protein,$sub_link);
206 : overbeek 1.4
207 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
208 :     foreach $_ (@$subsystem_data)
209 :     {
210 :     ($sub,$role,$protein) = @$_;
211 :     push(@{$in{$sub}->{$role}},&HTML::fid_link($cgi,$protein,0) . ": " . scalar $fig->function_of($protein));
212 :     }
213 :     foreach $sub (sort keys(%in))
214 :     {
215 :     $sub_link = &sub_link($cgi,$sub);
216 :     push(@$html,$cgi->h2($sub_link));
217 :     my $roles = [];
218 :     foreach $role (sort keys(%{$in{$sub}}))
219 :     {
220 :     push(@$roles,$cgi->ul($cgi->li($in{$sub}->{$role})));
221 :     }
222 :     push(@$html,$cgi->ul($cgi->li($roles)));
223 :     }
224 : overbeek 1.4 }
225 : overbeek 1.5
226 :     sub handle_hypo_sub {
227 :     my($fig,$cgi,$html,$genome) = @_;
228 :    
229 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
230 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
231 :     my $col_hdrs = ["PEG","Function","Subsystem"];
232 :     my $tab = [];
233 :     foreach $_ (@$assignments_data)
234 :     {
235 :     my($peg,$func) = @$_;
236 :     if (&FIG::hypo($func) && ($subs{$peg}))
237 :     {
238 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
239 :     }
240 :     }
241 :     $_ = @$tab;
242 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs in Subsystems"));
243 : overbeek 1.5 }
244 :    
245 :     sub handle_hypo_nosub {
246 :     my($fig,$cgi,$html,$genome) = @_;
247 :    
248 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
249 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
250 :     my $col_hdrs = ["PEG","Function"];
251 :     my $tab = [];
252 :     foreach $_ (@$assignments_data)
253 :     {
254 :     my($peg,$func) = @$_;
255 :     if (&FIG::hypo($func) && (! $subs{$peg}))
256 :     {
257 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
258 :     }
259 :     }
260 :     $_ = @$tab;
261 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Hypothetical Pegs NOT in Subsystems"));
262 : overbeek 1.5 }
263 :    
264 :     sub handle_nothypo_sub {
265 :     my($fig,$cgi,$html,$genome) = @_;
266 :    
267 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
268 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
269 :     my $col_hdrs = ["PEG","Function","Subsystem"];
270 :     my $tab = [];
271 :     foreach $_ (@$assignments_data)
272 :     {
273 :     my($peg,$func) = @$_;
274 :     if ((! &FIG::hypo($func)) && ($subs{$peg}))
275 :     {
276 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func,&sub_link($cgi,$subs{$peg})]);
277 :     }
278 :     }
279 :     $_ = @$tab;
280 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs in Subsystems"));
281 : overbeek 1.5 }
282 :    
283 :     sub handle_nothypo_nosub {
284 :     my($fig,$cgi,$html,$genome) = @_;
285 :    
286 : overbeek 1.6 my($subsystem_data,$assignments_data) = &get_data($fig,$cgi,$genome);
287 :     my %subs = map { $_->[2] => $_->[0] } @$subsystem_data;
288 :     my $col_hdrs = ["PEG","Function"];
289 :     my $tab = [];
290 :     foreach $_ (@$assignments_data)
291 :     {
292 :     my($peg,$func) = @$_;
293 :     if ((! &FIG::hypo($func)) && (! $subs{$peg}))
294 :     {
295 :     push(@$tab,[&HTML::fid_link($cgi,$peg,0),$func]);
296 :     }
297 :     }
298 :     $_ = @$tab;
299 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$_ Nonhypothetical Pegs NOT in Subsystems"));
300 : overbeek 1.5 }
301 :    
302 : overbeek 1.6 sub get_data {
303 :     my($fig,$cgi,$genome) = @_;
304 :    
305 :     my $rdbH = $fig->db_handle;
306 :     my $subsystem_data = $rdbH->SQL("SELECT DISTINCT subsystem,role,protein FROM subsystem_index WHERE ( protein like 'fig\|$genome.peg.%')");
307 :     my $assignment_data = $rdbH->SQL("SELECT prot,assigned_function FROM assigned_functions WHERE ( prot like 'fig\|$genome.peg.%' AND made_by = 'master' )");
308 :    
309 :     return ($subsystem_data,$assignment_data);
310 :     }
311 :    
312 :     sub sub_link {
313 :     my($cgi,$sub) = @_;
314 :     my($sub_link);
315 :    
316 :     my $user = $cgi->param('user');
317 :     if ($user)
318 :     {
319 :     $sub_link = "<a href=./subsys.cgi?ssa_name=$sub&request=show_ssa&user=$user>$sub</a>";
320 :     }
321 :     else
322 :     {
323 :     $sub_link = $sub;
324 :     }
325 :     return $sub_link;
326 :     }
327 : overbeek 1.8
328 :     sub get_basic_stats {
329 :     my($fig,$genome) = @_;
330 :    
331 :     my $rdbH = $fig->db_handle;
332 :     my $relational_db_response = $rdbH->SQL("SELECT gname,szdna,pegs,rnas,taxonomy FROM genome WHERE genome = '$genome'");
333 :     my($gname,$szdna,$pegs,$rnas,$taxonomy) = @{$relational_db_response->[0]};
334 :     my $szdna = &commify($szdna);
335 :     my $num_contigs = scalar $fig->all_contigs($genome);
336 :     return ($gname,$szdna,$num_contigs,$pegs,$rnas,$taxonomy);
337 :     }
338 :    
339 :     sub table_of_genomes {
340 :     my($fig,$cgi,$html) = @_;
341 :     my(@genomes);
342 :    
343 :     push(@$html,"<pre>\n");
344 :     if ($cgi->param('complete'))
345 :     {
346 :     @genomes = $fig->genomes("complete");
347 :     }
348 :     else
349 :     {
350 :     @genomes = $fig->genomes;
351 :     }
352 :    
353 :     my $genome;
354 :     push(@$html,join("\t","Genome ID","Complete","Genome Name","Size (bp)","Number Contigs","CDSs","RNAs","Taxonomy") . "\n");
355 :     my $genome;
356 :     foreach $genome (@genomes)
357 :     {
358 :     push(@$html,join("\t",($genome,$fig->is_complete($genome),&get_basic_stats($fig,$genome))) . "\n");
359 :     }
360 :     push(@$html,"</pre>\n");
361 :     }
362 :    
363 :    
364 : overbeek 1.9 sub subsys_summary {
365 :     my($fig,$cgi,$html) = @_;
366 :     my($Nsubs,$genome,$sub,$role,$peg,$genome_instances,%genomes_in_use,$peg_instances,%pegs_in_use);
367 :     foreach $sub ($fig->all_subsystems)
368 :     {
369 :     $Nsubs++;
370 :     foreach $genome (map { $_->[0] } @{$fig->subsystem_genomes($sub)})
371 :     {
372 :     $genome_instances++;
373 :     $genomes_in_use{$genome}++;
374 :     foreach $role ($fig->subsystem_to_roles($sub))
375 :     {
376 :     foreach $peg ($fig->pegs_in_subsystem_cell($sub,$genome,$role))
377 :     {
378 :     $peg_instances++;
379 :     $pegs_in_use{$peg}++;
380 :     }
381 :     }
382 :     }
383 :     }
384 :     my $Ngenomes = scalar keys(%genomes_in_use);
385 :     my $Npegs = scalar keys(%pegs_in_use);
386 :     my $g_in_sub = int($genome_instances / $Nsubs);
387 :     my $p_in_sub = int($peg_instances / $Nsubs);
388 :     push(@$html,$cgi->h1('Subsystem Summary'));
389 :     push(@$html,$cgi->br,
390 :     "<b>Number Subsystems:</b> $Nsubs",$cgi->br,
391 :     "<b>Genomes in Subsystems:</b> $Ngenomes",$cgi->br,
392 :     "<b>PEGs in Subsystems:</b> $Npegs",$cgi->br,
393 :     "<b>Avg genomes per subsystem:</b> $g_in_sub",$cgi->br,
394 :     "<b>Avg PEGs per subsystem:</b> $p_in_sub",$cgi->br
395 :     );
396 :     return
397 :    
398 :     }
399 : redwards 1.10
400 : redwards 1.14 sub kv_peg_stats {
401 :     my ($fig, $cgi, $html, $genome)=@_;
402 :    
403 :     #RAE Added the coverage of each genome with different attributes for the PEGs to find the number of genes that are in pirsf, etc
404 :     push(@$html, "\n<div class=\"pegattributes\">\n<p><h2>PEG Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
405 :    
406 :     my $pegtags=$fig->get_tags('peg');
407 :     foreach my $type (sort {$a cmp $b} keys %$pegtags)
408 :     {
409 : redwards 1.15 my @result = grep {$_ =~ /$genome/} @{$pegtags->{$type}};
410 :     push(@$html, "\nPEGS with tag: $type : ", scalar(@result), $cgi->br, "\n");
411 : redwards 1.14 }
412 :     }
413 :    
414 : redwards 1.10 sub kv_stats {
415 :     my ($fig, $cgi, $html, $genome, $edit)=@_;
416 :    
417 :     # RAE Added tables for key value pairs for an organism, and allow you to edit them
418 :     # figure out kv's for the organism, and make a table with them
419 :    
420 :     # if the optional edit boolean is set and a user is supplied, we will make a table where you can edit the KV pairs
421 :     # else we will just make a blank table
422 :    
423 : redwards 1.12 # prepare the html so we can add form fields here
424 :     push(@$html, "\n<div class=\"attributes\">\n<p><h2>Attributes for ", $fig->genus_species($genome), "</h2></p>\n");
425 :     if ($edit) {push(@$html, $cgi->start_form(-action=>"genome_statistics.cgi"))}
426 :    
427 :    
428 : redwards 1.10 my $tab=[];
429 :     my $user=$cgi->param('user');
430 :     my $col_hdrs=["Attribute", "Value"];
431 : redwards 1.11 if ($user && $edit) {$col_hdrs=["Attribute", "Value", "URL"]}
432 : redwards 1.10
433 :     my $known;
434 : redwards 1.13 foreach my $key (sort {$a->[1] cmp $b->[1]} $fig->get_attributes($genome)) {
435 :     $known->{$key->[1]}=1;
436 : redwards 1.10 if ($user && $edit) {
437 :     push @$tab,
438 :     [
439 : redwards 1.13 $key->[1],
440 :     $cgi->textfield(-name=>"value.".$key->[1], -default=>$key->[2], -size=>50),
441 :     $cgi->textfield(-name=>"url.".$key->[1], -default=>$key->[3], -size=>50),
442 : redwards 1.10 ];
443 :     } else {
444 : redwards 1.13 if ($key->[3] && $key->[3] =~ /^http/) {$key->[2] = "<a href=\"" . $key->[3] . "\">". $key->[2] . "</a>"}
445 : redwards 1.10 push @$tab,
446 :     [
447 : redwards 1.13 $key->[1],
448 :     $key->[2],
449 : redwards 1.10 ];
450 :     }
451 :     }
452 :    
453 :    
454 :     if ($edit) {
455 :     # now we want to add some pull down menus for things that we can add. And some blank boxes too for free text entry.
456 :     # start with three of each
457 :     my $opt=$fig->get_tags("genome"); # all the tags we know about
458 :     my @options=sort {uc($a) cmp uc($b)} grep {!$known->{$_}} keys %$opt;
459 :     unshift(@options, undef); # a blank field at the start
460 :     for (my $i=1; $i<= (scalar @options + 5); $i++) {
461 :    
462 :     # we have the options, and 5 blank fields for free text entry
463 :     my $choice=$cgi->popup_menu(-name=>"key.$i", -values=>\@options);
464 :     if ($i >= scalar @options) {$choice = $cgi->textfield(-name=>"key.$i", -size=>50)}
465 :     push @$tab,
466 :     [
467 :     $choice,
468 :     $cgi->textfield(-name=>"value.$i", -size=>50),
469 :     $cgi->textfield(-name=>"url.$i", -size=>50),
470 :     ];
471 :     }
472 : 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
473 :     push(@$html, $cgi->hidden(-name=>"max new keys", -value=>scalar @options + 5));
474 : redwards 1.10 }
475 :    
476 :     # now just write the html
477 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Attributes"));
478 :     if ($edit) {
479 :     push(@$html, $cgi->hidden("genome"), $cgi->hidden("user"), $cgi->hidden("request"));
480 :     push(@$html, $cgi->submit('Change'), $cgi->reset());
481 :     }
482 :     else {
483 :     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");
484 :     }
485 :     }
486 :    
487 :    
488 :     sub edit_kv_stats {
489 :     my ($fig, $cgi, $html, $genome)=@_;
490 :     if ($cgi->param("Change")) {
491 :     # we have changed the values
492 :     # get the old kv pairs so we can see what has changed
493 :     my $changed; my $deleted;
494 :     foreach my $key ($fig->get_attributes($genome)) {
495 : redwards 1.13 if (!$cgi->param('value.'.$key->[1]) && !$cgi->param('url.'.$key->[1])) {
496 :     $fig->delete_attribute($genome, $key->[1]);
497 : redwards 1.10 push @$key, ["deleted", "td colspan=2 style=\"text-align: center\""];
498 :     push @$deleted, $key;
499 :     }
500 : redwards 1.13 elsif (($cgi->param('value.'.$key->[1]) ne $key->[2]) || ($cgi->param('url.'.$key->[1]) ne $key->[3])) {
501 :     $fig->change_attribute($genome, $key->[1], $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]));
502 :     push @$key, $cgi->param('value.'.$key->[1]), $cgi->param('url.'.$key->[1]);
503 : redwards 1.10 push @$changed, $key;
504 :     }
505 :     }
506 :    
507 :     my $added;
508 : redwards 1.12 for (my $i=0; $i <= $cgi->param("max new keys"); $i++) {
509 : redwards 1.10 if ($cgi->param("key.$i")) {
510 :     $fig->add_attribute($genome, $cgi->param("key.$i"), $cgi->param("value.$i"), $cgi->param("url.$i"));
511 :     push @$added, [$cgi->param("key.$i"), ["added", "td colspan=2 style=\"text-align: center\""], $cgi->param("value.$i"), $cgi->param("url.$i")];
512 :     }
513 :     }
514 :    
515 :     # now all we have to do is create a table to report what we have done.
516 :     my $tab=[];
517 :     push (@$html, "<div class=\"altered\"><p><h2>Attributes Altered for ", $fig->genus_species($genome), " ($genome)</h2></p>");
518 :     my $col_hdrs=["Attribute", "Original Value", "Original URL", "New Value", "New URL"];
519 :     if ($changed) {push @$tab, [["<strong>Changed Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$changed}
520 :     if ($deleted) {push @$tab, [["<strong>Deleted Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$deleted}
521 :     if ($added) {push @$tab, [["<strong>Added Attributes", "td colspan=5 bgcolor=gray style=\"text-align: center\""]], @$added}
522 :    
523 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Changed Data"));
524 :     }
525 :     else {
526 :     return kv_stats($fig, $cgi, $html, $genome, 1);
527 :     }
528 :     }
529 :    
530 : redwards 1.17 sub subsys_homol {
531 :     my ($fig,$cgi,$html, $genome)=@_;
532 : overbeek 1.18
533 :     if (!$genome && $cgi->param('korgs')) {$genome=$cgi->param('korgs')}
534 :     if (!$genome) {push @$html, 'Please specify a genome\n'; return}
535 :    
536 : redwards 1.17 # here we are going to get some subsystems based on what genes are present and what they are homologous to
537 : overbeek 1.18 my ($maxN, $maxP)=(($cgi->param('maxN') or 5), ($cgi->param('maxP') or 1e-20));
538 :     my $sscount;
539 : redwards 1.17 foreach my $peg ($fig->pegs_of($genome)) {
540 : overbeek 1.18 map {$sscount->{$_->[0]}->{'Annotated'}++} $fig->subsystems_for_peg($peg);
541 :     map {map {$sscount->{$_->[0]}->{'Homology'}->{$peg}++} $fig->subsystems_for_peg($_->[1])} $fig->sims($peg, $maxN, $maxP, 'fig');
542 : redwards 1.17 }
543 :    
544 : overbeek 1.18 my %label;
545 :     my @ss=sort {$a cmp $b} keys %$sscount;
546 :     my @labels=raelib->subsys_names_for_display(@ss);
547 :     foreach my $i (0 .. @ss) {$label{$ss[$i]}=$labels[$i]}
548 :    
549 :     my $col_hdrs=["Susbystems", "Proteins in subsystem", "Proteins by<br>homology to other<br>proteins in subsystems"];
550 : redwards 1.17 my $tab=[];
551 : overbeek 1.18 foreach my $ss (@ss) {
552 :     $sscount->{$ss}->{"Homology"}={} unless (exists $sscount->{$ss}->{"Homology"});
553 :     my @row=("<a href='/FIG/subsys.cgi?user=$user&ssa_name=$ss&request=show_ssa&can_alter=&check=&sort=by_phylo&show_clusters=1' target='_blank'>$label{$ss}</a>");
554 :     push @row, ($sscount->{$ss}->{"Annotated"} or 0), scalar(keys %{$sscount->{$ss}->{"Homology"}});
555 : redwards 1.17 push @$tab, \@row;
556 :     }
557 : overbeek 1.18 my $title="Pegs in " . $fig->genus_species($genome) ." ($genome) that are, or could, be in subsystems";
558 :     push @$html, "<h2>Pegs In Subsystems</h2><p>These are the numbers of proteins in subsystems or that could be in subsystems",
559 :     ".\n The scond column is the number of proteins that are actually in subsystems. ",
560 :     "\nThe third column is the number of proteins that are similar to a protein in that subsystem ",
561 :     " (with a cutoff of $maxP and only looking through $maxN sims for each protein).\n",
562 :     "<br>You can change these numbers below, but be careful -- more sims means the searching will take a lot longer and may time out!</p>",
563 :     &HTML::make_table($col_hdrs,$tab,$title),
564 :     $cgi->start_form(), $cgi->hidden("request"), $cgi->p,
565 :     "<table border=0><tr><td>Enter the max number of similarities to look through:</td><td>",
566 :     $cgi->textfield(-name=>"maxN", -value=>$maxN, -size=>2), "</td></tr>\n<tr><td>Enter the maximum E value:</td><td>",
567 :     $cgi->textfield(-name=>"maxP", -value=>$maxP, -size=>6), "</td></tr></table>\n", $cgi->p,
568 :     raelib->scrolling_org_list($cgi, 0, $genome), $cgi->p, $cgi->submit, $cgi->reset, $cgi->end_form;
569 :    
570 : redwards 1.17 }
571 :    
572 :    
573 : redwards 1.10
574 : redwards 1.17

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3