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

Annotation of /FigWebServices/pom.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (view) (download)

1 : olson 1.16 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : overbeek 1.2
19 : efrank 1.1 use FIG;
20 :     my $fig = new FIG;
21 :    
22 :     use HTML;
23 :     use strict;
24 :     use GenoGraphics;
25 : overbeek 1.17 use raelib; # this is used for the scrolling_org list
26 :     my $rae=raelib->new;
27 :    
28 : efrank 1.1 use CGI;
29 :     my $cgi = new CGI;
30 : overbeek 1.17 use CGI::Carp qw(fatalsToBrowser);
31 : efrank 1.1
32 :     if (0)
33 :     {
34 : overbeek 1.21 my $VAR1;
35 :     eval(join("",`cat /tmp/pom_parms`));
36 :     $cgi = $VAR1;
37 :     # print STDERR &Dumper($cgi);
38 :     }
39 :    
40 :     if (0)
41 :     {
42 : efrank 1.1 print $cgi->header;
43 :     my @params = $cgi->param;
44 :     print "<pre>\n";
45 :     foreach $_ (@params)
46 :     {
47 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
48 :     }
49 : overbeek 1.21
50 :     if (0)
51 :     {
52 :     if (open(TMP,">/tmp/pom_parms"))
53 :     {
54 :     print TMP &Dumper($cgi);
55 :     close(TMP);
56 :     }
57 :     }
58 : efrank 1.1 exit;
59 :     }
60 : overbeek 1.17 my $html = ["<TITLE>The SEED Roles</TITLE>"];
61 : efrank 1.1
62 :     my $role = $cgi->param('role');
63 :    
64 :     my($request);
65 : overbeek 1.17 if ($cgi->param('Occurrences') || $cgi->param('request') eq "Occurrences") { $request = "show_occurrences"; $cgi->delete('Occurrences') }
66 : overbeek 1.11 elsif ($cgi->param('Occurrences by similarity')) { $request = "show_occ_sim"; $cgi->delete('Occurrences by similarity') }
67 : efrank 1.1 elsif ($cgi->param('Clusters')) { $request = "find_clusters"; $cgi->delete('Clusters') }
68 :     elsif ($cgi->param('FC')) { $request = "find_fc"; $cgi->delete('FC') }
69 : overbeek 1.18 elsif ($cgi->param('EC')) { $request = "ec_only"}
70 : efrank 1.1 elsif ($request = $cgi->param('request')) { $cgi->delete('request') }
71 :     else { $request = "" }
72 :    
73 :     if ($request eq "show_occurrences")
74 :     {
75 :     &show_occurrences($fig,$cgi,$html);
76 :     }
77 : overbeek 1.11 elsif ($request eq "show_occ_sim")
78 :     {
79 :     &show_occ_sim($fig,$cgi,$html,$role);
80 :     }
81 : efrank 1.1 elsif ($request eq "show_pegs")
82 :     {
83 :     &show_pegs($fig,$cgi,$html,$role);
84 :     }
85 :     elsif ($request eq "find_in_org")
86 :     {
87 :     &find_in_org($fig,$cgi,$html,$role);
88 :     }
89 :     elsif ($request eq "find_clusters")
90 :     {
91 :     &find_clusters($fig,$cgi,$html);
92 :     }
93 :     elsif ($request eq "find_fc")
94 :     {
95 :     &find_fc($fig,$cgi,$html,$role);
96 :     }
97 : overbeek 1.18 elsif ($request eq "ec_only")
98 :     {
99 :     $role=[$cgi->param('EC')];
100 :     &ec_only($fig,$cgi,$html,$role);
101 :     }
102 : efrank 1.1 elsif ($request eq "full_fc_summary")
103 :     {
104 :     &full_fc_summary($fig,$cgi,$html,$role);
105 :     }
106 :     elsif ($request eq "quick_fc_summary")
107 :     {
108 :     &quick_fc_summary($fig,$cgi,$html,$role);
109 :     }
110 :     else
111 :     {
112 :     &show_initial($fig,$cgi,$html,$role);
113 :     }
114 :    
115 :     &HTML::show_page($cgi,$html);
116 : overbeek 1.18 exit;
117 : efrank 1.1
118 : olson 1.12 #
119 :     # Find the given role in the given (via CGI params) organism.
120 :     #
121 :     # We do this by finding a list of pegs that are annotated to have
122 :     # this role in other organisms that are "close enough" to our organism
123 :     #
124 :     # We then find pegs in this organism that are similar to
125 :     # these pegs.
126 :     #
127 : efrank 1.1 sub find_in_org {
128 :     my($fig,$cgi,$html,$role) = @_;
129 :     my($user,$id2,$psc,$col_hdrs,$tab,$peg,$curr_func,$id2_func);
130 :     my($seen,$peg);
131 :    
132 :     ($user = $cgi->param('user')) || ($user = "");
133 :     my $org = $cgi->param('org');
134 : overbeek 1.17 my @allroles;
135 :     if ($role eq "All Roles") {@allroles=$cgi->param('allroles')} else {push @allroles, $role}
136 :    
137 : efrank 1.1 if ($org)
138 :     {
139 : olson 1.12 #
140 :     # Create a list of candidates.
141 :     #
142 :     # These are the list of sequences that contain the given role,
143 :     # sorted by the crude_estimate_of_distance from the given peg.
144 :     #
145 : overbeek 1.17
146 :     $tab=[];
147 :     foreach my $r (@allroles) {
148 :     my @cand = map { $_->[0] }
149 :     sort { $a->[1] <=> $b->[1] }
150 :     map { $peg = $_; [$peg,$fig->crude_estimate_of_distance($org,&FIG::genome_of($peg))] }
151 : overbeek 1.20 grep { $_ =~ /\.peg\./ }
152 : overbeek 1.17 $fig->seqs_with_role($r,$user);
153 : efrank 1.1
154 : overbeek 1.17 my $hits = {};
155 :     $seen = {};
156 : olson 1.12
157 : overbeek 1.17 #
158 :     # Pick the top 10 hits if there are more than 10.
159 :     #
160 :     my $how_many = (@cand > 10) ? 10 : scalar @cand;
161 : olson 1.12
162 : overbeek 1.17 &try_to_locate($fig,$org,$hits,[@cand[0..$how_many - 1]],$seen);
163 : olson 1.12
164 : overbeek 1.17 if (keys(%$hits) == 0)
165 :     {
166 :     splice(@cand,0,$how_many);
167 :     &try_to_locate($fig,$org,$hits,\@cand,$seen);
168 :     }
169 : efrank 1.1
170 : overbeek 1.17 #
171 :     # At this point %$hits contains the pegs in our organism that
172 :     # may have the given role. The key is the peg, the value
173 :     # is a pair [score, similar-peg]
174 :     #
175 : olson 1.12
176 : overbeek 1.17 $col_hdrs = ["P-Sc","PEG","Ln1","Current Function", "Protein Hit","Ln2","Function"];
177 :     foreach $peg ( sort {$hits->{$a}->[0] <=> $hits->{$b}->[0]} keys(%$hits))
178 :     {
179 :     ($psc,$id2) = @{$hits->{$peg}};
180 :     $curr_func = $fig->function_of($peg,$user);
181 :     $id2_func = $fig->function_of($id2,$user);
182 :     push(@$tab,[$psc,&HTML::fid_link($cgi,$peg,1),$fig->translation_length($peg),$curr_func,&HTML::fid_link($cgi,$id2),$fig->translation_length($id2),$id2_func]);
183 :     }
184 :     }
185 : efrank 1.1 if (@$tab > 0)
186 :     {
187 : overbeek 1.17 push(@$html,&HTML::make_table($col_hdrs,$tab,"Possible PEGs"));
188 : efrank 1.1 }
189 :     else
190 :     {
191 : overbeek 1.17 push(@$html,$cgi->h1("Sorry, we could not locate any candidates for ".(join ", ", @allroles). " in $org "));
192 : efrank 1.1 }
193 :     }
194 :     else
195 :     {
196 :     push(@$html,$cgi->h1("Error: no organism specified"));
197 :     }
198 :     }
199 :    
200 : olson 1.12 #
201 :     # Mark in $hits the pegs in $org that are similar to
202 :     # pegs in other organisms that have the given role.
203 :     #
204 : efrank 1.1 sub try_to_locate {
205 :     my($fig,$org,$hits,$to_try,$seen) = @_;
206 :     my($prot,$id2,$psc,$id2a,$x,$sim);
207 :    
208 :     my $cutoff = $cgi->param('sims_cutoff');
209 :     if (! $cutoff) { $cutoff = 1.0e-5 }
210 :    
211 : olson 1.12 #
212 :     # @$to_try is a list of pegs
213 :     #
214 : efrank 1.1 foreach $prot (@$to_try)
215 :     {
216 : olson 1.12 #
217 :     # If we've not looked at it before ...
218 :     #
219 : efrank 1.1 if (! $seen->{$prot})
220 :     {
221 : overbeek 1.14 if ($fig->genome_of($prot) eq $org)
222 :     {
223 :     $hits->{$prot} = [0,$prot];
224 :     }
225 :     else
226 : efrank 1.1 {
227 : olson 1.12 #
228 : overbeek 1.14 # Retrieve the top 1000 sims for this peg. raw
229 :     # means don't expand.
230 : olson 1.12 #
231 : overbeek 1.14 foreach $sim ($fig->sims($prot,1000,$cutoff,"raw",0))
232 : efrank 1.1 {
233 : overbeek 1.14 $id2 = $sim->id2;
234 :     $psc = $sim->psc;
235 :    
236 : olson 1.12 #
237 : overbeek 1.14 # Retrieve the proteins that the sims map to.
238 :     #
239 :    
240 :     foreach $id2a (map { $_->[0] } $fig->mapped_prot_ids($id2))
241 : efrank 1.1 {
242 : overbeek 1.14 #
243 :     # If it's a protein in the organism we're looking in,
244 :     # and if it's a better hit than the hit we had before,
245 :     # mark it in $hits->{id} with the score and the
246 :     # protein id.
247 :     #
248 :     if (($id2a =~ /^fig\|(\d+\.\d+)/) && ($1 eq $org))
249 : efrank 1.1 {
250 : overbeek 1.14 $x = $hits->{$id2a};
251 :     if ((! $x) || ($x->[0] > $psc))
252 :     {
253 :     $hits->{$id2a} = [$sim->psc,$prot];
254 :     }
255 : efrank 1.1 }
256 : overbeek 1.14 #
257 :     # Otherwise, mark it as having been seen if the score is good enough.
258 :     #
259 :     elsif ($psc < 1.0e-20)
260 : efrank 1.1 {
261 : overbeek 1.14 {
262 :     $seen->{$id2a} = 1;
263 :     }
264 : efrank 1.1 }
265 :     }
266 :     }
267 :     }
268 :     }
269 :     }
270 :     }
271 :    
272 :     sub show_pegs {
273 :     my($fig,$cgi,$html,$role) = @_;
274 :     my($peg,@pegs,$user,$col_hdrs,$tab);
275 :    
276 :     @pegs = $cgi->param('peg');
277 :     ($user = $cgi->param('user')) || ($user = "");
278 :     if (@pegs > 0)
279 :     {
280 :     $col_hdrs = ["PEG","Function"];
281 :     $tab = [];
282 :     foreach $peg (@pegs)
283 :     {
284 :     my $func = $fig->function_of($peg,$user);
285 :     my $link = &HTML::fid_link($cgi,$peg);
286 :     push(@$tab,[$link,$func]);
287 :     }
288 :     my $role_ext = &HTML::ec_link($fig->expand_ec($role));
289 :     my $gs = $fig->org_of($pegs[0]);
290 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs possibly implementing $role_ext in $gs"));
291 :     }
292 :     }
293 :    
294 : overbeek 1.19 sub old_show_occ_sim {
295 : efrank 1.1 my($fig,$cgi,$html) = @_;
296 :     my($neigh,@roles);
297 :    
298 :     my @orgs = $cgi->param('korgs');
299 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
300 :    
301 : overbeek 1.21 if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) > 0)
302 : efrank 1.1 {
303 : overbeek 1.21 &show_occ_by_sims($fig,$cgi,$html,$orgs[0],\@roles);
304 : overbeek 1.11 }
305 :     else
306 :     {
307 : overbeek 1.21 push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
308 : overbeek 1.11 }
309 :     }
310 :    
311 : overbeek 1.19 sub show_occ_sim {
312 : overbeek 1.11 my($fig,$cgi,$html) = @_;
313 : overbeek 1.17 my(@neigh,@roles);
314 : overbeek 1.11
315 : overbeek 1.21 if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) == 0)
316 : overbeek 1.11 {
317 : overbeek 1.17 @roles = $cgi->param('role');
318 :     }
319 :    
320 : overbeek 1.19
321 :     @roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } @roles;
322 :    
323 :     my @orgs=$cgi->param('korgs');
324 :     if (scalar(@orgs) != 1)
325 :     {
326 :     push(@$html,$cgi->h1("Please choose just a single organism from the list so we can look through its sims"));
327 :     return;
328 :     }
329 :    
330 :     if (@roles > 0)
331 :     {
332 :     my @genomes=$fig->genomes("complete");
333 :     my $ss = &make_ss(\@genomes,\@roles,$orgs[0]);
334 :     &show_occ_body_like_ss($fig,$cgi,$html,\@roles,$ss,\@genomes);
335 :     }
336 :     else
337 :     {
338 :     push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
339 :     }
340 : efrank 1.1 }
341 :    
342 :    
343 : overbeek 1.19 sub show_occurrences {
344 :     my($fig,$cgi,$html) = @_;
345 :     my(@neigh,@roles);
346 :    
347 : overbeek 1.21 if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) == 0)
348 : overbeek 1.19 {
349 :     @roles = $cgi->param('role');
350 :     }
351 :    
352 :     #push @$html, $cgi->div({class=>"diagnostic"}, $cgi->p("Neighborhood: ", join ("<br />", @neigh)), $cgi->p("ROLES: ", @roles));
353 :     @roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } @roles;
354 :     if (@roles > 0)
355 :     {
356 :     &show_occ_by_assignments($fig,$cgi,$html,\@roles);
357 :     }
358 :     else
359 :     {
360 :     push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
361 :     }
362 : efrank 1.1 }
363 : overbeek 1.11
364 : overbeek 1.19
365 : efrank 1.1 sub show_occ_by_assignments {
366 :     my($fig,$cgi,$html,$roles) = @_;
367 :     my $user;
368 :    
369 :     ($user = $cgi->param('user')) || ($user = "");
370 : overbeek 1.17 my @genomes;
371 :     ($cgi->param('korgs')) ? (@genomes=$cgi->param('korgs')) : (@genomes=$fig->genomes("complete"));
372 :     #push @$html, $cgi->div({class=>"diagnostic"}, $cgi->p("KORGS: |", $cgi->param('korgs'), "|"), $cgi->p("GENOMES: |",join("|", @genomes),"|"));
373 :     my $ss = $fig->seqs_with_roles_in_genomes(\@genomes,$roles,$user);
374 :     &show_occ_body_like_ss($fig,$cgi,$html,$roles,$ss,\@genomes);
375 : efrank 1.1 }
376 :    
377 :     sub make_ss {
378 :     my($orgs,$roles,$org) = @_;
379 :     my($role,$peg,$id2,$sim);
380 :     my $ss = {};
381 :    
382 :     my %orgs = map { $_ => 1 } @$orgs;
383 :     my($roles1,$roles2);
384 :     $roles1 = [];
385 :     $roles2 = [];
386 :     foreach $role (@$roles)
387 :     {
388 :     if ($role =~ /^fig/)
389 :     {
390 :     push(@$roles2,$role);
391 :     }
392 :     else
393 :     {
394 :     push(@$roles1,$role);
395 :     }
396 :     }
397 : overbeek 1.11
398 :     if (@$roles1 > 0)
399 : efrank 1.1 {
400 : overbeek 1.11 my $ss1 = $fig->seqs_with_roles_in_genomes([$org],$roles1);
401 :     foreach $role (keys(%{$ss1->{$org}}))
402 : efrank 1.1 {
403 : overbeek 1.11 foreach $peg (map { $_->[0] } @{$ss1->{$org}->{$role}})
404 : efrank 1.1 {
405 : overbeek 1.11 foreach $sim ($fig->sims($peg,500,1.0e-10,"fig"))
406 : efrank 1.1 {
407 : overbeek 1.11 $id2 = $sim->id2;
408 :     if ($id2 =~ /^fig\|(\d+\.\d+)/)
409 :     {
410 :     $ss->{$1}->{$role}->{$id2} = 1;
411 :     }
412 : efrank 1.1 }
413 :     }
414 :     }
415 :     }
416 :    
417 :     foreach $peg (@$roles2)
418 :     {
419 : overbeek 1.18 foreach $sim ($fig->sims($peg,500,1.0e-10,"figx"))
420 : efrank 1.1 {
421 :     $id2 = $sim->id2;
422 :     if ($id2 =~ /^fig\|(\d+\.\d+)/)
423 :     {
424 : overbeek 1.11 $ss->{$1}->{$peg}->{$id2} = 1;
425 : efrank 1.1 }
426 : overbeek 1.6 }
427 :     }
428 :    
429 :     my $org;
430 :     foreach $org (keys(%$ss))
431 :     {
432 :     my $sub1 = $ss->{$org};
433 :     foreach $role (keys(%$sub1))
434 :     {
435 :     my $sub2 = $sub1->{$role};
436 : overbeek 1.11 $sub1->{$role} = [map { [$_,""] } sort { &FIG::by_fig_id($a,$b) } keys(%$sub2)];
437 : efrank 1.1 }
438 :     }
439 :     return $ss;
440 :     }
441 :    
442 : overbeek 1.18 sub ec_only {
443 :     my($fig,$cgi,$html,$roles) = @_;
444 :     my $col_hdrs = ["Column","Functional Role", "Subsystems", "KEGG"];
445 :     my $tab = [];
446 :    
447 :    
448 :     foreach my $r (@$roles)
449 :     {
450 :     my $ssinfo;
451 :     foreach my $ssi ($fig->subsystems_for_ec($r))
452 :     {
453 :     $ssinfo->{$ssi->[0]}->{$ssi->[1]}++;
454 :     }
455 :    
456 :     foreach my $subsys (sort {$a cmp $b} keys %$ssinfo)
457 :     {
458 :     foreach my $ssrole (sort {$ssinfo->{$b} <=> $ssinfo->{$a} || $a cmp $b} keys %{$ssinfo->{$subsys}})
459 :     {
460 :     push @$tab, [$fig->expand_ec($r), $ssrole, &HTML::sub_link($cgi, $subsys), &HTML::ec_link($r)];
461 :     }
462 :     }
463 :     }
464 :    
465 :    
466 :    
467 :     push(@$html,
468 :     $cgi->start_form(-action=>"pom.cgi", -method=>"get"),
469 :     $cgi->div({class=>"bluefloat"}, "This table shows the role(s) that you have chosen, their functions, a link to the subsystem(s) they are in, and a link to the KEGG site in Japan"),
470 :     &HTML::make_table(["Function", "Functional Role<br>In Subsystem", "Subsystem", "KEGG"], $tab,"Functional Roles")
471 :     );
472 :     }
473 :    
474 :    
475 : overbeek 1.17 sub show_occ_body_like_ss {
476 :     # RAE:
477 :     # Added this method that makes the display look like the display from subsys.cgi and gives us a more uniform feel to everything. Also rearranged slightly
478 :    
479 :     my($fig,$cgi,$html,$roles,$ss,$genomes) = @_;
480 :     my($x,$i,%pos,$user,$genome,$row);
481 : overbeek 1.18 #$push @$html, $cgi->div({class=>"diagnostic"}, $cgi->p("ROLE: $role"));
482 : overbeek 1.17 push @$html, $cgi->h1("POM in the neighborhood of ", &HTML::ec_link($fig->expand_ec($role)), "\n");
483 :    
484 :     # generate the functions and figure out what is here
485 :     # note that tab1 is generated below so we can include sslinks
486 :     my $function;
487 :     for ($i=0; ($i < @$roles); $i++)
488 :     {
489 :     $pos{$roles->[$i]} = $i+1;
490 :     if ($roles->[$i] !~ /^fig/)
491 :     {
492 :     $function->{$i}=$fig->expand_ec($roles->[$i]);
493 :     }
494 :     else
495 :     {
496 :     $function->{$i}=scalar($fig->function_of($roles->[$i]));
497 :     }
498 :     }
499 :    
500 :     my $col_hdrs2 = ["Genome<br />ID", "Organism"];
501 :     push @$col_hdrs2, map {"<a " . FIGjs::mouseover("Functional Role", $function->{$_}) . ">".($_+1)."</a>"} (0..$#$roles);
502 :     my $inter_headers; # these are the headeers that will be interspersed in the table
503 :     @$inter_headers=map {$_=[$_, "th"]} @$col_hdrs2; # convert those to <th> </th> elements using arrays and the "coloring" code
504 :    
505 :     my $tab2 = [];
506 :    
507 :     #foreach $genome ($fig->sort_genomes_by_taxonomy(keys(%$ss)))
508 :     my $subsystems;
509 :     foreach $genome (sort {$fig->genus_species($a) cmp $fig->genus_species($b)} @$genomes)
510 :     {
511 :     $cgi->delete($role);
512 :     $cgi->delete('neighborhood');
513 :     $cgi->delete('request');
514 :     $cgi->delete('peg');
515 :     $cgi->delete('org');
516 :     $cgi->delete('korgs');
517 :    
518 :     $row = [$genome, $fig->genus_species($genome)];
519 :     for ($i=0;($i < @$roles); $i++)
520 :     {
521 :     $cgi->param(-name => "role",
522 :     -value => $roles->[$i]);
523 :    
524 :     $x = $ss->{$genome}->{$roles->[$i]};
525 :    
526 :     my @links;
527 :     if (defined($x))
528 :     {
529 :     foreach my $peg (map {$_->[0]} @$x)
530 :     {
531 :     my @subsyslist=$fig->peg_to_subsystems($peg);
532 :     map {$subsystems->{$roles->[$i]}->{$_}=1} @subsyslist;
533 :     #if ($cgi->param('show') eq "all" || (scalar(@subsyslist)))
534 :     if (scalar(@subsyslist))
535 :     {
536 :     my $link = ( $cgi->param('ext_ids') ? external_id($fig,$cgi,$peg) : HTML::fid_link($cgi,$peg, "local") );
537 :     # horrible, horrible botch. Please ignore this
538 :     my $mo=FIGjs::mouseover("Subsystems", (join("<br />", @subsyslist)));
539 :     $link =~ s/<a\s+/<a $mo /;
540 :     push @links, "<span style=\"background-color: #FF0\">$link</span>";
541 :     }
542 :     #elsif ($cgi->param('show') eq "all")
543 :     else
544 :     {
545 :     my $link = ( $cgi->param('ext_ids') ? external_id($fig,$cgi,$peg) : HTML::fid_link($cgi,$peg, "local") );
546 :     push @links, $link;
547 :     }
548 :     }
549 :     }
550 :     #else
551 :     #{
552 :     # $cgi->param(-name => "request",
553 :     # -value => "find_in_org");
554 :     # $cgi->param(-name => "org",
555 :     # -value => "$genome");
556 :     # my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
557 :     # push @links, "<a href=$url>0</a>";
558 :     # }
559 :     unless (@links) {@links=" &nbsp; "}
560 :     push(@$row,join (", <br />", @links));
561 :     }
562 :     push(@$tab2,$row);
563 :     unless (scalar(@$tab2) % 10) {push @$tab2, $inter_headers}
564 :     }
565 :    
566 :     my $col_hdrs1 = ["Column","Functional Role", "Subsystems", "KEGG"];
567 :     my $tab1 = [];
568 :     for ($i=0; ($i < @$roles); $i++)
569 :     {
570 :     my $sslinks=join("; <br />", map {&HTML::sub_link($cgi, $_)} keys %{$subsystems->{$roles->[$i]}});
571 :     if ($roles->[$i] !~ /^fig/)
572 :     {
573 :     push(@$tab1,[$i+1,$function->{$i}, $sslinks, &HTML::ec_link($roles->[$i])]);
574 :     }
575 :     else
576 :     {
577 :     push(@$tab1,[$i+1,$function->{$i}, $sslinks, &HTML::fid_link($cgi,$roles->[$i])]);
578 :     }
579 :     }
580 :    
581 :     my $glabels={map {($_=>$fig->genus_species($_))} @$genomes};
582 :     my $rlabels={map {($roles->[$_]=>$function->{$_})} 0..$#$roles};
583 :     push(@$html,
584 :     $cgi->start_form(-action=>"pom.cgi", -method=>"get"),
585 :     $cgi->div({class=>"bluefloat"}, "This table shows the role(s) that you have selected, their functions, a link to the subsystem(s) they are in, and a link to the KEGG site in Japan"),
586 :     &HTML::make_table($col_hdrs1,$tab1,"Functional Roles"),$cgi->hr,
587 :     $cgi->div({class=>"bluefloat"}, $cgi->p("This table shows which proteins in these genomes have this role, and if you mouse over each protein it will show you which subsystems that protein is in. Only cells with yellow backgrounds are in subsystems, others are not."), $cgi->p("The columns are the same as the roles listed in the table above. If you mouse over the column headers (or their repetitions throughout) you will get the functional roles shown")),
588 :     &HTML::make_table($col_hdrs2,$tab2,"Occurrences of Roles in POM"), $cgi->p,
589 :     $cgi->p("To get suggestions for proteins that are missing from this table, choose a genome and role from these menus:"),
590 :     $cgi->hidden(-name=>"request", -value=>"find_in_org"), $cgi->hidden(-name=>"allroles", -value=>[keys %$rlabels]),
591 :     $cgi->popup_menu(-name=>"org", -values=>[sort {$glabels->{$a} cmp $glabels->{$b}} keys %$glabels], -labels=>$glabels), $cgi->br,
592 :     $cgi->popup_menu(-name=>"role", -values=>["All Roles", sort {$rlabels->{$a} cmp $rlabels->{$b}} keys %$rlabels], -labels=>$rlabels, -default=>"All Roles"),
593 :     $cgi->br, $cgi->submit, $cgi->reset, $cgi->end_form,
594 :     );
595 :     }
596 : overbeek 1.18
597 : efrank 1.1 sub show_occ_body {
598 : overbeek 1.17 my($fig,$cgi,$html,$roles,$ss,$genomes) = @_;
599 : efrank 1.1 my($x,$col_hdrs,$tab,$i,%pos,$user,$genome,$row);
600 :    
601 :     $col_hdrs = ["Column","Functional Role"];
602 :     $tab = [];
603 : overbeek 1.18 for (my $i=0; ($i < @$roles); $i++)
604 : efrank 1.1 {
605 :     $pos{$roles->[$i]} = $i+1;
606 :     if ($roles->[$i] !~ /^fig/)
607 :     {
608 :     push(@$tab,[$i+1,&HTML::ec_link($fig->expand_ec($roles->[$i]))]);
609 :     }
610 :     else
611 :     {
612 :     push(@$tab,[$i+1,&HTML::fid_link($cgi,$roles->[$i])]);
613 :     }
614 :     }
615 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Roles in POM"),$cgi->hr);
616 :    
617 :     $col_hdrs = ["Genome",1..@$roles];
618 :     $tab = [];
619 :    
620 : overbeek 1.17 #foreach $genome ($fig->sort_genomes_by_taxonomy(keys(%$ss)))
621 :     foreach $genome (sort {$fig->genus_species($a) cmp $fig->genus_species($b)} @$genomes)
622 : efrank 1.1 {
623 :     $cgi->delete($role);
624 :     $cgi->delete('neighborhood');
625 :     $cgi->delete('request');
626 :     $cgi->delete('peg');
627 :     $cgi->delete('org');
628 : overbeek 1.17 $cgi->delete('korgs');
629 : efrank 1.1
630 :     $row = [ $fig->genus_species($genome)];
631 :     for ($i=0;($i < @$roles); $i++)
632 :     {
633 :     my($link,$n,$pegs,$url);
634 :     $cgi->param(-name => "role",
635 :     -value => $roles->[$i]);
636 :    
637 :     $x = $ss->{$genome}->{$roles->[$i]};
638 :     if (defined($x) && (@$x > 1))
639 :     {
640 :     $cgi->param(-name => "peg",
641 :     -value => [map { $_->[0] } @$x]);
642 :     $cgi->param(-name => "request",
643 :     -value => "show_pegs");
644 :    
645 : overbeek 1.15 $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
646 : efrank 1.1 $n = scalar @$x;
647 :     $link = "<a href=$url>$n</a>";
648 :     }
649 :     elsif (defined($x) && (@$x == 1))
650 :     {
651 : overbeek 1.15 $url = $cgi->url(-relative => 1) . "?prot=$x->[0]->[0]&user=$user";
652 : efrank 1.1 $url =~ s/pom.cgi/protein.cgi/;
653 :     $link = "<a href=$url>1</a>";
654 :     }
655 :     else
656 :     {
657 :     $cgi->param(-name => "request",
658 :     -value => "find_in_org");
659 :     $cgi->param(-name => "org",
660 :     -value => "$genome");
661 : overbeek 1.15 $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
662 : efrank 1.1 $link = "<a href=$url>0</a>";
663 :     }
664 :     push(@$row,$link);
665 :     }
666 :     push(@$tab,$row);
667 :     }
668 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Occurrences of Roles in POM"));
669 :     }
670 :    
671 :     sub show_initial {
672 :     my($fig,$cgi,$html,$role) = @_;
673 :    
674 : overbeek 1.22 my($roles_in_textarea,@neigh);
675 :     if ((! $role) && ($roles_in_textarea = $cgi->param('roles_in_textarea')))
676 :     {
677 :     $roles_in_textarea =~ tr/\r/\n/;
678 :     @neigh = grep { $_ } split(/\n/,$roles_in_textarea);
679 :     }
680 :    
681 :     if ((! $role) && (! @neigh))
682 : efrank 1.1 {
683 : overbeek 1.19 my @roles=$fig->all_roles();
684 :     my %rr=map {$_->[0]=>$_->[0]." - ". $_->[1]} @roles;
685 :     push @$html, $cgi->start_form, $cgi->h1("POM - Pieces of Metabolism"),
686 : overbeek 1.22 $cgi->p("Please choose a role. Pick ECs, or carefully paste a set into the textarea"),
687 : overbeek 1.19 $cgi->scrolling_list(-name=>"role", -values=>[sort {$a cmp $b} keys %rr], -labels=>\%rr, -multiple=>1, -size=>10),
688 : overbeek 1.22 $cgi->br,
689 :     $cgi->textarea( -name => 'roles_in_textarea', -rows => 6, columns => 100),
690 : overbeek 1.19 $cgi->p(),
691 :     $cgi->submit, $cgi->reset, $cgi->end_form;
692 : efrank 1.1 return;
693 :     }
694 :    
695 :     my $user = $cgi->param('user');
696 : overbeek 1.17 push(@$html,$cgi->start_form(-action => "pom.cgi", -name=> "pom", -method=>"GET"));
697 : efrank 1.1 if ($user)
698 :     {
699 :     push(@$html,$cgi->hidden(-name => "user", -value => $user));
700 :     }
701 : overbeek 1.22
702 :     if (! @neigh)
703 :     {
704 :     @neigh = map { $fig->expand_ec($_) } ($fig->neighborhood_of_role($role));
705 :     }
706 : overbeek 1.17 #my $rows = @neigh + 5;
707 :    
708 :     # -values => \@neigh,
709 :     # -default => \@neigh,
710 : efrank 1.1
711 :     my($org,$gs);
712 : overbeek 1.17 push(@$html,
713 :     $cgi->h1("These are the roles in the neighborhood of ", &HTML::ec_link($fig->expand_ec($role)), "\n"),
714 :     $cgi->div({class=>"bluefloat"},
715 :     $cgi->p("Please select one or more of these roles to explore the presence in different genomes.",
716 :     " You can select the genomes in the menu below."),
717 :     ),
718 :    
719 :     $cgi->checkbox_group( -name => 'neighborhood',
720 :     -values => \@neigh,
721 :     -default => \@neigh,
722 :     -columns => 2,
723 : efrank 1.1 ),
724 : overbeek 1.17 $cgi->p({style=>"margin-bottom: 3em"},&HTML::java_buttons("pom", "neighborhood")),
725 :    
726 :     $cgi->div({class=>"bluefloat"},
727 :     $cgi->p("To explore these roles, you can either look for occurences in all the genomes by not selecting anything, ",
728 :     " or you can select one or more genomes from this list to narrow your search.")),
729 :     $rae->scrolling_org_list($cgi, 1),
730 : efrank 1.1 $cgi->br,
731 :     );
732 :    
733 : overbeek 1.17 # push(@$html,$cgi->textarea( -name => 'neighborhood',
734 :     # -value => join("\n",@neigh),
735 :     # -rows => $rows,
736 :     # -cols => 70
737 :     # ),
738 : efrank 1.1 push(@$html,"Similarity Threshhold: ",
739 :     $cgi->textfield(-name => "sims_cutoff", -value => 1.0e-10,-size => 8), $cgi->br,
740 :     $cgi->hidden(-name => 'role', -value => $role),
741 :     $cgi->submit('Occurrences'),
742 : overbeek 1.11 $cgi->submit('Occurrences by similarity'),
743 : efrank 1.1 $cgi->submit('Clusters'),
744 :     $cgi->submit('FC'),
745 :     $cgi->end_form
746 :     );
747 :     }
748 :    
749 :     sub find_clusters {
750 :     my($fig,$cgi,$html) = @_;
751 :     my($neigh,@roles,$user,$ss,$org,@pegs,$x,$y,$role,$peg,$loc,$contig,$beg,$end);
752 :     my($i,$j,$col_hdrs,$tab,@clusters,$cluster,$gs);
753 :    
754 : overbeek 1.21 if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) > 0)
755 : efrank 1.1 {
756 : overbeek 1.21 ($user = $cgi->param('user')) || ($user = "");
757 :     @clusters = $fig->largest_clusters(\@roles,$user,1);
758 :    
759 :     $col_hdrs = ["PEG","function"];
760 :     foreach $cluster (@clusters)
761 : efrank 1.1 {
762 : overbeek 1.21 $tab = [];
763 :     $gs = $fig->org_of($cluster->[0]);
764 : efrank 1.1
765 : overbeek 1.21 foreach $peg (@$cluster)
766 : efrank 1.1 {
767 : overbeek 1.21 push(@$tab,[&HTML::fid_link($cgi,$peg,1),scalar $fig->function_of($peg,$user)]);
768 : efrank 1.1 }
769 : overbeek 1.21 push(@$html,&HTML::make_table($col_hdrs,$tab,"Cluster in $gs"),$cgi->hr);
770 : efrank 1.1 }
771 :     }
772 :     }
773 :    
774 :     sub find_fc {
775 :     my($fig,$cgi,$html,$role) = @_;
776 :     my($peg_index_data,$peg,$n,@poss,$col_hdrs,$tab);
777 :    
778 :     ($peg_index_data,undef) = $fig->search_index($role);
779 :     foreach $peg (map { $_->[0] } @$peg_index_data)
780 :     {
781 :     my @tmp = $fig->in_cluster_with($peg);
782 :     $n = @tmp;
783 :     if ($n > 0)
784 :     {
785 :     push(@poss,[$n,$peg]);
786 :     }
787 :     }
788 :     @poss = sort { $b->[0] <=> $a->[0] } @poss;
789 :     $col_hdrs = ["Size Cluster","PEG","Function"];
790 :     $tab = [map { ($n,$peg) = @$_; [$n,&HTML::fid_link($cgi,$peg),scalar $fig->function_of($peg,$cgi->param('user'))] } @poss];
791 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs that show Functional Coupling"));
792 :     $cgi->delete('neighborhood');
793 :    
794 :     my $min = int((@poss * 0.8) / 60);
795 :     $cgi->delete('request');
796 :     $cgi->param(-name => "request", -value => "quick_fc_summary");
797 : overbeek 1.15 my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
798 : efrank 1.1 push(@$html,$cgi->br,
799 :     "<a href=$url>Quick FC Summary [estimated time = $min minutes]</a>");
800 :    
801 :     $min = int((@poss * 15) / 60);
802 :     $cgi->param(-name => "request", -value => "full_fc_summary");
803 : overbeek 1.15 my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
804 : efrank 1.1 push(@$html,$cgi->br,
805 :     "<a href=$url>Full FC Summary [estimated time = $min minutes]</a>");
806 :     }
807 :    
808 :     sub full_fc_summary {
809 :     my($fig,$cgi,$html,$role) = @_;
810 :     my($peg_index_data,$peg,$peg1,@coupling_data,$coupled,$score,$func,$func1);
811 :     my(@hypos,%non_hypos);
812 :    
813 :     my $expanded = $fig->expand_ec($role);
814 :     ($peg_index_data,undef) = $fig->search_index($role);
815 :     foreach $peg (map { $_->[0] } @$peg_index_data)
816 :     {
817 :     $func = $fig->function_of($peg,$cgi->param('user'));
818 : overbeek 1.10 @coupling_data = $fig->coupling_and_evidence($peg,5000,1.0e-10,0.1,"keep");
819 : efrank 1.1 foreach $coupled (@coupling_data)
820 :     {
821 :     ($score,$peg1) = @$coupled;
822 :     $func1 = $fig->function_of($peg1,$cgi->param('user'));
823 :     if (&FIG::hypo($func1))
824 :     {
825 :     push(@hypos,[$func1,$score,$peg,$peg1]);
826 :     }
827 :     else
828 :     {
829 :     if ((! $non_hypos{$func1}) || ($non_hypos{$func1}->[0] < $score))
830 :     {
831 :     $non_hypos{$func1} = [$score,$peg,$peg1];
832 :     }
833 :     }
834 :     }
835 :     }
836 :     &tabulate_results($fig,$cgi,$html,$role,\%non_hypos,\@hypos);
837 :     }
838 :    
839 :     sub tabulate_results {
840 :     my($fig,$cgi,$html,$role,$non_hypos,$hypos) = @_;
841 :     my($entry,$func1,$score,$peg,$peg1,$func);
842 :     my(@hypos,%non_hypos,$func,@poss);
843 :    
844 :     my $expanded = $fig->expand_ec($role);
845 :     my @poss = sort { $b->[1] <=> $a->[1] } map { [$_,@{$non_hypos->{$_}}] } keys(%$non_hypos);
846 :     my $col_hdrs = ["Coupling Score","PEG1","Function1","PEG2","Function2"];
847 :     my $tab = [];
848 :     foreach $entry (@poss)
849 :     {
850 :     ($func1,$score,$peg,$peg1) = @$entry;
851 :     $func = $fig->function_of($peg,$cgi->param('user'));
852 :     push(@$tab,[$score,
853 :     &HTML::fid_link($cgi,$peg),$func,
854 :     &HTML::fid_link($cgi,$peg1),$func1]);
855 :     }
856 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Functions Coupled to $expanded"));
857 :     push(@$html,$cgi->hr);
858 :    
859 :     $tab = [];
860 :     @poss = sort { $b->[1] <=> $a->[1] } @$hypos;
861 :     $tab = [];
862 :     foreach $entry (@poss)
863 :     {
864 :     ($func1,$score,$peg,$peg1) = @$entry;
865 :     $func = $fig->function_of($peg,$cgi->param('user'));
866 :     push(@$tab,[$score,
867 :     &HTML::fid_link($cgi,$peg),$func,
868 :     &HTML::fid_link($cgi,$peg1),$func1]);
869 :     }
870 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Hypothetical Proteins Coupled to $expanded"));
871 :     }
872 :    
873 :     sub quick_fc_summary {
874 :     my($fig,$cgi,$html,$role) = @_;
875 :     my($peg_index_data,$peg,$peg1,%relevant,%close_enough,$func1,@pinned);
876 :     my(%non_hypos,@hypos,$sc,%seen);
877 :    
878 :     ($peg_index_data,undef) = $fig->search_index($role);
879 :     my @all_pegs = map { $_->[0] } @$peg_index_data;
880 :    
881 :     foreach $peg (@all_pegs)
882 :     {
883 :     my @close = $fig->close_genes($peg,5000);
884 :     foreach $peg1 (@close)
885 :     {
886 :     $close_enough{$peg1} = 1;
887 :     }
888 :     }
889 :    
890 :     foreach $peg (@all_pegs)
891 :     {
892 :     foreach $peg1 (grep { $close_enough{$_} } $fig->in_cluster_with($peg))
893 :     {
894 :     if ($peg1 ne $peg)
895 :     {
896 :     $relevant{$peg1} = $peg;
897 :     }
898 :     }
899 :     }
900 :    
901 :     foreach $peg (keys(%relevant))
902 :     {
903 :     if (! $seen{$peg})
904 :     {
905 :     $seen{$peg} = 1;
906 :     @pinned = grep { $relevant{$_} && (! $seen{$_}) } $fig->in_pch_pin_with($peg);
907 :     if (@pinned > 1)
908 :     {
909 : overbeek 1.10 $sc = $fig->score(\@pinned);
910 : efrank 1.1 foreach $peg1 (@pinned)
911 :     {
912 :     $seen{$peg1} = 1;
913 :     $func1 = $fig->function_of($peg1,$cgi->param('user'));
914 :     if (&FIG::hypo($func1))
915 :     {
916 :     push(@hypos,[$func1,$sc,$relevant{$peg1},$peg1]);
917 :     }
918 :     else
919 :     {
920 :     if ((! $non_hypos{$func1}) || ($non_hypos{$func1}->[0] < $sc))
921 :     {
922 :     $non_hypos{$func1} = [$sc,$relevant{$peg1},$peg1];
923 :     }
924 :     }
925 :     }
926 :     }
927 :     }
928 :     }
929 :     &tabulate_results($fig,$cgi,$html,$role,\%non_hypos,\@hypos);
930 :     }
931 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3