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

Annotation of /FigWebServices/extend_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3