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

Annotation of /FigWebServices/extend_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (view) (download)

1 : heiko 1.1 # -*- perl -*-
2 : olson 1.11 #
3 : golsen 1.13 # Copyright (c) 2003-2008 University of Chicago and Fellowship
4 : olson 1.11 # 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 : heiko 1.1
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use Subsystem;
24 :    
25 :     use HTML;
26 :     use strict;
27 :    
28 :     use CGI;
29 :     my $cgi = new CGI;
30 :    
31 : overbeek 1.2 if (0)
32 : heiko 1.1 {
33 :     my $VAR1;
34 :     eval(join("",`cat /tmp/extend_ssa_parms`));
35 :     $cgi = $VAR1;
36 :     # print STDERR &Dumper($cgi);
37 :     }
38 :    
39 :     if (0)
40 :     {
41 :     print $cgi->header;
42 :     my @params = $cgi->param;
43 :     print "<pre>\n";
44 :     foreach $_ (@params)
45 :     {
46 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
47 :     }
48 :    
49 :     if (0)
50 :     {
51 :     if (open(TMP,">/tmp/extend_ssa_parms"))
52 :     {
53 :     print TMP &Dumper($cgi);
54 :     close(TMP);
55 :     }
56 :     }
57 :     exit;
58 :     }
59 :     my($genome);
60 :    
61 :     my $html = [];
62 :     my $subsys = $cgi->param('subsystem');
63 :     if (! $subsys)
64 :     {
65 :     my @ssa = &existing_subsystem_annotations;
66 :    
67 :     if (@ssa > 0)
68 :     {
69 :     &format_ssa_table($cgi,$html,\@ssa);
70 :     }
71 :     else
72 :     {
73 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
74 :     }
75 :     }
76 :     elsif ($subsys && ($cgi->param('request') eq "extend_ssa"))
77 :     {
78 :     &pick_a_genome($cgi,$fig,$html,$subsys);
79 :     }
80 :     elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "extend_ssa_with_genome"))
81 :     {
82 :     $genome =~ s/:.*$//;
83 :     &show_candidates($fig,$cgi,$html,$subsys,$genome);
84 :     }
85 :     elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "add_genome") && $cgi->param('Add Genome'))
86 :     {
87 :     $genome =~ s/:.*$//;
88 :     &make_assignments($cgi,$fig,$html);
89 :     &add_a_genome($cgi,$fig,$html,$genome);
90 : overbeek 1.10 # &pick_a_genome($cgi,$fig,$html,$subsys);
91 : heiko 1.1 }
92 :     elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "add_genome") && $cgi->param('Just Make Assignments'))
93 :     {
94 :     $genome =~ s/:.*$//;
95 :     &make_assignments($cgi,$fig,$html);
96 :     &pick_a_genome($cgi,$fig,$html,$subsys);
97 :     }
98 :     else
99 :     {
100 :     push(@$html,$cgi->h1('invalid parameters'));
101 :     }
102 :    
103 :     &HTML::show_page($cgi,$html);
104 :    
105 :     sub format_ssa_table {
106 :     my($cgi,$html,$ssaP) = @_;
107 :    
108 :     push(@$html, $cgi->start_form(-action => "extend_subsys.cgi",
109 :     -method => 'post'),
110 :     $cgi->hidden(-name => 'request', -value => 'extend_ssa', -override => 1),
111 :     $cgi->scrolling_list( -name => 'subsystem',
112 :     -values => [ map { $_->[0] } @$ssaP ],
113 :     -size => 10
114 :     ),
115 :     $cgi->br,
116 :     $cgi->submit( 'Pick One' ),
117 :     $cgi->end_form
118 :     );
119 :     }
120 :    
121 :     sub existing_subsystem_annotations {
122 :     my($ssa,$name);
123 :     my @ssa = ();
124 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
125 :     {
126 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
127 :     closedir(SSA);
128 :     }
129 :     return sort { $a->[0] cmp $b->[0] } @ssa;
130 :     }
131 :    
132 :     sub curator {
133 :     my($ssa) = @_;
134 :     my($who) = "";
135 :    
136 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
137 :     {
138 :     $_ = <DATA>;
139 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
140 :     {
141 :     $who = $1;
142 :     }
143 :     close(DATA);
144 :     }
145 :     return $who;
146 :     }
147 :    
148 :     sub show_candidates {
149 : overbeek 1.6 my($fig,$cgi,$html,$subsys,$genome_to_show) = @_;
150 : heiko 1.1 my($role,$known,@has,%has_filled,$x,$i,$tuple);
151 :    
152 :     my $sub = $fig->get_subsystem($subsys);
153 :     my @genomes = $sub->get_genomes;
154 :     my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
155 :     my @roles = $sub->get_roles;
156 :    
157 :     foreach $genome (@genomes)
158 :     {
159 :    
160 :     next if (! &ok_variant($variant_codes{$genome}));
161 :     @has = ();
162 :     foreach $role (@roles)
163 :     {
164 :     push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? 1 : 0);
165 :     }
166 :     push(@{$has_filled{join("",@has)}},$genome);
167 :     }
168 :    
169 :     my @candidates = ();
170 :     foreach $role (@roles)
171 :     {
172 :     $known = [];
173 :     foreach $genome (@genomes)
174 :     {
175 :     push(@$known,$sub->get_pegs_from_cell($genome,$role));
176 :     }
177 : overbeek 1.6 push(@candidates,[sort { $a->[2] <=> $b->[2] } $fig->best_bbh_candidates($genome_to_show,1.0e-20,10,$known)]);
178 : heiko 1.1 }
179 : overbeek 1.6
180 : heiko 1.1 @has = ();
181 :     foreach $x (@candidates)
182 :     {
183 :     push(@has,(@$x > 0) ? 1 : 0);
184 :     }
185 :    
186 :     my $best_so_far = 0;
187 :     my $closest_variant;
188 :     foreach $x (keys(%has_filled))
189 :     {
190 :     if (($_ = &matched($x,\@has)) && ($_ > $best_so_far))
191 :     {
192 :     $best_so_far = $_;
193 :     $closest_variant = $x;
194 :     }
195 :     }
196 :    
197 :     if ($best_so_far)
198 :     {
199 :     $x = $has_filled{$closest_variant};
200 :     my %variants;
201 :     foreach $_ (@$x)
202 :     {
203 :     $variants{$variant_codes{$_}}++;
204 :     }
205 :     my @ordered = sort { $variants{$b} <=> $variants{$a} } keys(%variants);
206 : overbeek 1.4 my $gs = $fig->genus_species($x->[0]);
207 :     push(@$html,$cgi->h1("It is possible that $genome: " . $fig->genus_species($genome) . " has an operational variant matching $gs"),
208 : heiko 1.1 $cgi->start_form(-action => "extend_subsys.cgi",
209 :     -method => 'post'),
210 :     $cgi->hidden(-name => 'genome', -value => $genome, -override => 1),
211 :     $cgi->hidden(-name => 'variant', -value => $ordered[0], -override => 1),
212 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
213 :     $cgi->hidden(-name => 'request', -value => 'add_genome', -override => 1)
214 :     );
215 :    
216 :     for ($i=0; ($i < @roles); $i++)
217 :     {
218 :     $x = $candidates[$i];
219 :     if (@$x > 0)
220 :     {
221 : overbeek 1.5 my $col_hdrs = ["Assign","Candidate","Length","Current Function","In Sub", "Score","Matched","Length","Function","UniProt Function"];
222 : heiko 1.1 my $tab = [];
223 :     foreach $tuple (@$x)
224 :     {
225 :     my($my_peg,$match_peg,$psc) = @$tuple;
226 :     my $my_peg_link = &HTML::fid_link($cgi, $my_peg, 1);
227 :     my $match_peg_link = &HTML::fid_link($cgi, $match_peg, 0);
228 :     my $checkbox = $cgi->checkbox(-name => "checked",
229 :     -value => "to=$my_peg,from=$match_peg",
230 :     -label => "");
231 :     my $my_len = $fig->translation_length($my_peg);
232 :     my $match_len = $fig->translation_length($match_peg);
233 :     my $my_fn = $fig->function_of($my_peg);
234 :     my $match_fn = $fig->function_of($match_peg);
235 : overbeek 1.4 my @in_sub = $fig->peg_to_subsystems($my_peg);
236 :     my $in_sub = (@in_sub > 0) ? @in_sub : "&nbsp;";
237 : overbeek 1.5 my $uni = $fig->to_alias($my_peg,"uni");
238 :     my $uni_func = $uni ? $fig->function_of($uni) : "";
239 : overbeek 1.3 push(@$tab, [($my_fn eq $match_fn) ? "&nbsp;" : $checkbox,
240 : overbeek 1.4 $my_peg_link, $my_len, $my_fn,$in_sub,
241 : heiko 1.1 $psc,
242 : overbeek 1.5 $match_peg_link, $match_len, $match_fn,$uni_func]);
243 : heiko 1.1 }
244 :    
245 :     push(@$html, &HTML::make_table($col_hdrs, $tab, "Candidates for $roles[$i]"),
246 :     $cgi->br,$cgi->br
247 :     );
248 :     }
249 :     }
250 :     push(@$html,$cgi->submit('Add Genome'), "&nbsp;&nbsp; ",
251 :     $cgi->submit('Just Make Assignments'),
252 :     $cgi->end_form
253 :     );
254 :     }
255 :     else
256 :     {
257 :     push(@$html,$cgi->h1('Probably does not have an operational variant'));
258 :     }
259 :     }
260 :    
261 :     sub known_hits {
262 :     my($fig,$genome,$roles) = @_;
263 :     my($role,$hits);
264 :    
265 :     $hits = 0;
266 :     foreach $role (@$roles)
267 :     {
268 :     if ($fig->seqs_with_role($role,"master",$genome))
269 :     {
270 :     $hits++;
271 :     }
272 :     }
273 :     return $hits;
274 :     }
275 :    
276 :     sub ok_variant {
277 :     my($variant) = @_;
278 :    
279 :     return ($variant && ($variant ne "-1"));
280 :     }
281 :    
282 :     sub matched {
283 :     my($string,$v) = @_;
284 :     my($n,$i);
285 :    
286 :     $n = 0;
287 :     for ($i=0; ($i < @$v); $i++)
288 :     {
289 : overbeek 1.4 if (substr($string,$i,1) )
290 : heiko 1.1 {
291 : overbeek 1.4 if ($v->[$i])
292 :     {
293 :     $n++;
294 :     }
295 :     else
296 :     {
297 :     return 0;
298 :     }
299 : heiko 1.1 }
300 :     }
301 :     return $n;
302 :     }
303 :    
304 :     sub pick_a_genome {
305 :     my($cgi,$fig,$html,$subsys) = @_;
306 :    
307 :     my($genome,%known_hits);
308 :    
309 :     my $sub = $fig->get_subsystem($subsys);
310 :     my @roles = $sub->get_roles;
311 :     my %in = map { $_ => 1 } $sub->get_genomes;
312 : redwards 1.12 my @out = grep { ! $in{$_} } grep { !$fig->is_environmental($_) } $fig->genomes("complete");
313 : heiko 1.1 foreach $genome (@out)
314 :     {
315 :     $known_hits{$genome} = &known_hits($fig,$genome,\@roles);
316 :     }
317 :     @out = sort { ($known_hits{$b} <=> $known_hits{$a}) or ($a cmp $b) } @out;
318 :     push(@$html, $cgi->start_form(-action => "extend_subsys.cgi",
319 :     -method => 'post'),
320 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
321 :     $cgi->hidden(-name => 'request', -value => 'extend_ssa_with_genome', -override => 1),
322 :     $cgi->scrolling_list( -name => 'genome',
323 :     -values => [ map { $genome = $_; "$genome: " . $fig->genus_species($genome) } @out ],
324 :     -size => 10
325 :     ),
326 :     $cgi->br,
327 :     $cgi->submit( 'Pick a Genome' ),
328 :     $cgi->end_form
329 :     );
330 :     }
331 :    
332 :     sub add_a_genome {
333 :     my($cgi,$fig,$html,$genome) = @_;
334 :    
335 :     my $sub = $fig->get_subsystem($subsys);
336 :     my @roles = $sub->get_roles;
337 : overbeek 1.8 my @genomes = $sub->get_genomes;
338 :     my $i;
339 : overbeek 1.9 for ($i=0; ($i < @genomes) && ($genomes[$i] ne $genome); $i++) {}
340 : overbeek 1.8 if ($i == @genomes)
341 :     {
342 :     $sub->add_genome($genome);
343 :     }
344 : heiko 1.1
345 :     $sub->set_variant_code($sub->get_genome_index($genome),$cgi->param('variant'));
346 :    
347 :     my $role;
348 :     foreach $role (@roles)
349 :     {
350 :     my @pegs = $fig->seqs_with_role($role,"master",$genome);
351 :     if (@pegs > 0)
352 :     {
353 :     $sub->set_pegs_in_cell($genome,$role,\@pegs);
354 :     }
355 :     }
356 :     $sub->write_subsystem;
357 :     push(@$html,$cgi->h1("Added $genome"));
358 :     }
359 :    
360 :     sub make_assignments {
361 :     my($cgi,$fig,$html) = @_;
362 :    
363 :     my $user = $cgi->param('user');
364 :     if (! $user) { $user = "master" }
365 :    
366 :     my $ent;
367 :     my @checked = $cgi->param('checked');
368 :     foreach $ent (@checked)
369 :     {
370 :     if ($ent =~ /^to=(.*),from=(.*)$/)
371 :     {
372 :     my $to_peg = $1;
373 :     my $from_peg = $2;
374 :    
375 :     my $from_func = $fig->function_of($from_peg);
376 :    
377 :     next unless $from_func;
378 :    
379 :     my $link = &HTML::fid_link($cgi, $to_peg, 0);
380 : golsen 1.13 push(@$html, "User $user assigning master function $from_func to $link<br>\n");
381 :     $fig->assign_function($to_peg,$user,$from_func,"");
382 :     # Now in assign_function
383 :     # $fig->add_annotation($to_peg,$user,"Set function to\n$from_func\n");
384 : heiko 1.1 }
385 :     }
386 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3