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

Annotation of /FigWebServices/show_exp_assertions.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
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 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use HTML;
24 :     use strict;
25 :    
26 :     use CGI;
27 :     my $cgi = new CGI;
28 :    
29 :     if (0)
30 :     {
31 :     my $VAR1;
32 :     eval(join("",`cat /tmp/exp_2c_parms`));
33 :     $cgi = $VAR1;
34 :     # print STDERR &Dumper($cgi);
35 :     }
36 :    
37 :     if (0)
38 :     {
39 :     print $cgi->header;
40 :     my @params = $cgi->param;
41 :     print "<pre>\n";
42 :     foreach $_ (@params)
43 :     {
44 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
45 :     }
46 :    
47 :     if (0)
48 :     {
49 :     if (open(TMP,">/tmp/exp_2c_parms"))
50 :     {
51 :     print TMP &Dumper($cgi);
52 :     close(TMP);
53 :     }
54 :     }
55 :     exit;
56 :     }
57 :     my($genome);
58 :    
59 :     my $html = [];
60 :     unshift @$html, "<TITLE>Show Solid Assertions</TITLE>\n";
61 :    
62 :     my $subsys = $cgi->param('subsystem');
63 :     my @options = $cgi->param('options');
64 :     my @rules = $cgi->param('rule');
65 :    
66 :     if (! $subsys)
67 :     {
68 :     my @ssa = &existing_subsystem_annotations;
69 :    
70 :     if (@ssa > 0)
71 :     {
72 :     &format_ssa_table($cgi,$html,\@ssa);
73 :     }
74 :     else
75 :     {
76 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
77 :     }
78 :     }
79 :     elsif ($subsys && (@options == 0))
80 :     {
81 :     &format_experts_and_options($cgi,$html,$fig,$subsys);
82 :     }
83 :     elsif ($subsys && (@options > 0) && (@rules == 0))
84 :     {
85 :     my @roles = &roles_for_sub($fig,$subsys);
86 :     if (@roles > 0)
87 :     {
88 :     &format_roles($cgi,$html,$fig,\@roles,$subsys,\@options);
89 :     }
90 :     else
91 :     {
92 :     push(@$html,$cgi->h1('Sorry, no roles defined'));
93 :     }
94 :     }
95 :     elsif (@rules > 0)
96 :     {
97 :     &add_rules($fig,$cgi,$html,\@rules);
98 :     my @roles = &roles_for_sub($fig,$subsys);
99 :     if (@roles > 0)
100 :     {
101 :     &format_roles($cgi,$html,$fig,\@roles,$subsys,\@options);
102 :     }
103 :     else
104 :     {
105 :     push(@$html,$cgi->h1('Sorry, no roles defined'));
106 :     }
107 :     }
108 :     else
109 :     {
110 :     push(@$html,$cgi->h1('invalid parameters'));
111 :     }
112 :    
113 :     &HTML::show_page($cgi,$html);
114 :    
115 :     sub format_ssa_table {
116 :     my($cgi,$html,$ssaP) = @_;
117 :    
118 :     push(@$html, $cgi->start_form(-action => "show_exp_assertions.cgi",
119 :     -method => 'post'),
120 :     $cgi->scrolling_list( -name => 'subsystem',
121 :     -values => [ map { $_->[0] } @$ssaP ],
122 :     -size => 10
123 :     ),
124 :     $cgi->br,
125 :     $cgi->submit( 'Pick One' ),
126 :     $cgi->end_form
127 :     );
128 :     }
129 :    
130 :     sub existing_subsystem_annotations {
131 :     my($ssa,$name);
132 :     my @ssa = ();
133 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
134 :     {
135 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
136 :     closedir(SSA);
137 :     }
138 :     return sort { $a->[0] cmp $b->[0] } @ssa;
139 :     }
140 :    
141 :     sub curator {
142 :     my($ssa) = @_;
143 :     my($who) = "";
144 :    
145 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
146 :     {
147 :     $_ = <DATA>;
148 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
149 :     {
150 :     $who = $1;
151 :     }
152 :     close(DATA);
153 :     }
154 :     return $who;
155 :     }
156 :    
157 :     sub roles_for_sub {
158 :     my($fig,$subsys) = @_;
159 :    
160 :     my $sub = $fig->get_subsystem($subsys);
161 :     my @roles = $sub->get_roles;
162 :     return @roles;
163 :     }
164 :    
165 : overbeek 1.2 use SOAP::Lite;
166 : overbeek 1.1 sub get_assertions {
167 :     my($fig,$pegs) = @_;
168 : overbeek 1.2
169 :     my $response = SOAP::Lite
170 :     -> uri('http://www.nmpdr.org/AnnoClearinghouse_SOAP')
171 :     -> proxy('http://bioseed.mcs.anl.gov/~paarmann/FIG/aclh-soap.cgi')
172 :     -> get_user_annotations( $pegs );
173 :    
174 : overbeek 1.3 if (! $response) { return () }
175 : overbeek 1.2 my %contribs = %{$response->result};
176 :    
177 :     return sort { &FIG::by_fig_id($a->[0],$b->[0]) } map { [$_,@{$contribs{$_}}] } keys(%contribs);
178 : overbeek 1.1 }
179 :    
180 :     sub format_roles {
181 :     my($cgi,$html,$fig,$roles,$subsys,$options) = @_;
182 :    
183 :     my %experts_to_show = map { $_ => 1 } @$options;
184 :     my $role;
185 :     my $subO = $fig->get_subsystem($subsys);
186 :     my @genomes = $subO->get_genomes;
187 :    
188 :     if ($experts_to_show{'just_different'})
189 :     {
190 :     push(@$html, $cgi->start_form(-action => "show_exp_assertions.cgi",
191 :     -method => 'post'),
192 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1)
193 :    
194 :     );
195 :     foreach my $opt (@$options)
196 :     {
197 :     push(@$html,$cgi->hidden(-name => 'options', -value => $opt, -override => 1));
198 :     }
199 :     }
200 :    
201 :     my $roles_shown = 0;
202 :     foreach $role (@$roles)
203 :     {
204 :     my $col_hdrs = ['Id','Organism','FIG Function','Expert','Expert Assertion'];
205 :     if ($experts_to_show{'just_different'})
206 :     {
207 :     push(@$col_hdrs,'To Add Rule');
208 :     }
209 :     my $tab = [];
210 :    
211 :     my @pegs = ();
212 :     foreach my $genome (@genomes)
213 :     {
214 :     push(@pegs,$subO->get_pegs_from_cell($genome,$role));
215 :     }
216 :    
217 :     my @assertions = sort { &FIG::by_fig_id($a->[0],$b->[0]) }
218 : overbeek 1.2 grep { $experts_to_show{'all'} || $experts_to_show{$_->[1]} }
219 : overbeek 1.1 &get_assertions($fig,\@pegs);
220 :     foreach my $tuple (@assertions)
221 :     {
222 : overbeek 1.2 my($peg,$expert,$exp_assertion) = @$tuple;
223 : overbeek 1.1 my $func = $fig->function_of($peg);
224 :     my $translated = $fig->translate_function($exp_assertion);
225 :     if (! ($experts_to_show{'just_different'} && ($func eq $translated)))
226 :     {
227 : overbeek 1.2 my $org = $fig->genus_species(&FIG::genome_of($peg));
228 : overbeek 1.1 my $row = [&HTML::fid_link($cgi,$peg),$org,$func,$expert];
229 :     if ($experts_to_show{'just_different'})
230 :     {
231 :     my $check = $cgi->checkbox(-name => 'rule',
232 :     -value => "$exp_assertion\t$func",
233 :     -checked => 0,
234 :     -override => 1,
235 :     -label => '');
236 :     push(@$row,($exp_assertion,$func ? $check : '' ));
237 :     }
238 :     else
239 :     {
240 :     push(@$row,$translated);
241 :     }
242 :     push(@$tab,$row);
243 :     }
244 :     }
245 :    
246 :     if (@$tab > 0)
247 :     {
248 :     $roles_shown++;
249 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs with Expert Assertions for $role"),
250 :     $cgi->br,$cgi->br);
251 :     }
252 :     }
253 :    
254 :     if ($roles_shown == 0)
255 :     {
256 :     push(@$html,$cgi->h2('no roles have expert assertions meeting the criteria to display'));
257 :     }
258 :    
259 :     elsif ($experts_to_show{'just_different'})
260 :     {
261 :     push(@$html,$cgi->br,
262 :     $cgi->submit( 'Add Translation Rules' ),
263 :     $cgi->end_form
264 :     );
265 :    
266 :     }
267 :     }
268 :    
269 :     sub format_experts_and_options {
270 :     my($cgi,$html,$fig,$subsys) = @_;
271 :    
272 :     push(@$html, $cgi->start_form(-action => "show_exp_assertions.cgi",
273 :     -method => 'post'),
274 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1)
275 :     );
276 :    
277 :     my $subO = $fig->get_subsystem($subsys);
278 :     my @pegs = $subO->get_all_pegs;
279 :     my @assertions = &get_assertions($fig,\@pegs);
280 :     my %by_whom = map { $_ => 1 } map { ($_->[3] eq 'Expert') ? $_->[4] : () } @assertions;
281 :     my @experts = sort keys(%by_whom);
282 :    
283 :     my $col_hdrs = ['','Expert'];
284 :     my $tab = [];
285 :    
286 :     my $check = $cgi->checkbox(-name => 'options',
287 :     -value => 'all',
288 :     -checked => 0,
289 :     -override => 1,
290 :     -label => '');
291 :    
292 :     push(@$tab,[$check,'all']);
293 :     foreach my $expert (@experts)
294 :     {
295 :     my $check = $cgi->checkbox(-name => 'options',
296 :     -value => $expert,
297 :     -checked => 0,
298 :     -override => 1,
299 :     -label => '');
300 :     push(@$tab,[$check,$expert]);
301 :     }
302 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"SHOW"),$cgi->br,$cgi->br);
303 :    
304 :     push(@$html,$cgi->checkbox(-name => 'options',
305 :     -value => 'just_different',
306 :     -checked => 0,
307 :     -override => 1,
308 :     -label => 'Show Only Differing Opinions'),
309 :     $cgi->br,
310 :     $cgi->submit( 'Show Expert Opinions' ),
311 :     $cgi->end_form
312 :     );
313 :     }
314 :    
315 :     sub add_rules {
316 :     my($fig,$cgi,$html,$rules) = @_;
317 :    
318 :     my($from,$to,$line);
319 :     my %tran = map { my($f1,$f2) = split(/\t/,$_); $f1 => $f2 } @$rules;
320 :     if (open(TMP,"<$FIG_Config::global/function.synonyms"))
321 :     {
322 :     while (defined($line = <TMP>))
323 :     {
324 :     chomp $line;
325 :     ($from,$to) = split(/\t/,$line);
326 :     if (($from ne $to) && (! $tran{$to}))
327 :     {
328 :     $tran{$from} = $to;
329 :     }
330 :     }
331 :     close(TMP);
332 :    
333 :     foreach $from (keys(%tran))
334 :     {
335 :     $to = $tran{$from};
336 :     while ($tran{$to})
337 :     {
338 :     $to = $tran{$to};
339 :     }
340 :     $tran{$from} = $to;
341 :     }
342 :     }
343 :    
344 :     if (open(TMP,">$FIG_Config::global/function.synonyms"))
345 :     {
346 :     foreach $from (sort keys(%tran))
347 :     {
348 :     print TMP "$from\t$tran{$from}\n";
349 :     }
350 :     close(TMP);
351 :     }
352 :     $_ = @$rules;
353 :     push(@$html,$cgi->h2("added $_ rules"));
354 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3