[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.9 - (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 :     sub format_roles {
166 :     my($cgi,$html,$fig,$roles,$subsys,$options) = @_;
167 :    
168 :     my %experts_to_show = map { $_ => 1 } @$options;
169 :     my $role;
170 :     my $subO = $fig->get_subsystem($subsys);
171 :     my @genomes = $subO->get_genomes;
172 :    
173 :     if ($experts_to_show{'just_different'})
174 :     {
175 :     push(@$html, $cgi->start_form(-action => "show_exp_assertions.cgi",
176 :     -method => 'post'),
177 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1)
178 :    
179 :     );
180 :     foreach my $opt (@$options)
181 :     {
182 :     push(@$html,$cgi->hidden(-name => 'options', -value => $opt, -override => 1));
183 :     }
184 :     }
185 :    
186 :     my $roles_shown = 0;
187 :     foreach $role (@$roles)
188 :     {
189 :     my $col_hdrs = ['Id','Organism','FIG Function','Expert','Expert Assertion'];
190 :     if ($experts_to_show{'just_different'})
191 :     {
192 :     push(@$col_hdrs,'To Add Rule');
193 :     }
194 :     my $tab = [];
195 :    
196 :     my @pegs = ();
197 :     foreach my $genome (@genomes)
198 :     {
199 : overbeek 1.5 push(@pegs,grep { $fig->is_real_feature($_) } $subO->get_pegs_from_cell($genome,$role));
200 : overbeek 1.1 }
201 :    
202 :     my @assertions = sort { &FIG::by_fig_id($a->[0],$b->[0]) }
203 : overbeek 1.2 grep { $experts_to_show{'all'} || $experts_to_show{$_->[1]} }
204 : overbeek 1.6 &FIG::get_expert_assertions(\@pegs);
205 : overbeek 1.1 foreach my $tuple (@assertions)
206 :     {
207 : overbeek 1.2 my($peg,$expert,$exp_assertion) = @$tuple;
208 : overbeek 1.1 my $func = $fig->function_of($peg);
209 :     my $translated = $fig->translate_function($exp_assertion);
210 :     if (! ($experts_to_show{'just_different'} && ($func eq $translated)))
211 :     {
212 : overbeek 1.2 my $org = $fig->genus_species(&FIG::genome_of($peg));
213 : overbeek 1.1 my $row = [&HTML::fid_link($cgi,$peg),$org,$func,$expert];
214 :     if ($experts_to_show{'just_different'})
215 :     {
216 :     my $check = $cgi->checkbox(-name => 'rule',
217 :     -value => "$exp_assertion\t$func",
218 :     -checked => 0,
219 :     -override => 1,
220 :     -label => '');
221 :     push(@$row,($exp_assertion,$func ? $check : '' ));
222 :     }
223 :     else
224 :     {
225 :     push(@$row,$translated);
226 :     }
227 :     push(@$tab,$row);
228 :     }
229 :     }
230 :    
231 :     if (@$tab > 0)
232 :     {
233 :     $roles_shown++;
234 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs with Expert Assertions for $role"),
235 :     $cgi->br,$cgi->br);
236 :     }
237 :     }
238 :    
239 :     if ($roles_shown == 0)
240 :     {
241 :     push(@$html,$cgi->h2('no roles have expert assertions meeting the criteria to display'));
242 :     }
243 :    
244 :     elsif ($experts_to_show{'just_different'})
245 :     {
246 :     push(@$html,$cgi->br,
247 :     $cgi->submit( 'Add Translation Rules' ),
248 :     $cgi->end_form
249 :     );
250 :    
251 :     }
252 :     }
253 :    
254 :     sub format_experts_and_options {
255 :     my($cgi,$html,$fig,$subsys) = @_;
256 :    
257 :     push(@$html, $cgi->start_form(-action => "show_exp_assertions.cgi",
258 :     -method => 'post'),
259 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1)
260 :     );
261 :    
262 :     my $subO = $fig->get_subsystem($subsys);
263 :     my @pegs = $subO->get_all_pegs;
264 : overbeek 1.7 my @assertions = &FIG::get_expert_assertions(\@pegs);
265 : overbeek 1.9 my %by_whom = map { $_->[1] => 1 } @assertions;
266 : overbeek 1.1 my @experts = sort keys(%by_whom);
267 :    
268 :     my $col_hdrs = ['','Expert'];
269 :     my $tab = [];
270 :    
271 :     my $check = $cgi->checkbox(-name => 'options',
272 :     -value => 'all',
273 :     -checked => 0,
274 :     -override => 1,
275 :     -label => '');
276 :    
277 :     push(@$tab,[$check,'all']);
278 :     foreach my $expert (@experts)
279 :     {
280 :     my $check = $cgi->checkbox(-name => 'options',
281 :     -value => $expert,
282 :     -checked => 0,
283 :     -override => 1,
284 :     -label => '');
285 :     push(@$tab,[$check,$expert]);
286 :     }
287 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"SHOW"),$cgi->br,$cgi->br);
288 :    
289 :     push(@$html,$cgi->checkbox(-name => 'options',
290 :     -value => 'just_different',
291 :     -checked => 0,
292 :     -override => 1,
293 :     -label => 'Show Only Differing Opinions'),
294 :     $cgi->br,
295 :     $cgi->submit( 'Show Expert Opinions' ),
296 :     $cgi->end_form
297 :     );
298 :     }
299 :    
300 :     sub add_rules {
301 :     my($fig,$cgi,$html,$rules) = @_;
302 :    
303 :     my($from,$to,$line);
304 :     my %tran = map { my($f1,$f2) = split(/\t/,$_); $f1 => $f2 } @$rules;
305 :     if (open(TMP,"<$FIG_Config::global/function.synonyms"))
306 :     {
307 :     while (defined($line = <TMP>))
308 :     {
309 :     chomp $line;
310 :     ($from,$to) = split(/\t/,$line);
311 :     if (($from ne $to) && (! $tran{$to}))
312 :     {
313 :     $tran{$from} = $to;
314 :     }
315 :     }
316 :     close(TMP);
317 :    
318 :     foreach $from (keys(%tran))
319 :     {
320 :     $to = $tran{$from};
321 :     while ($tran{$to})
322 :     {
323 :     $to = $tran{$to};
324 :     }
325 :     $tran{$from} = $to;
326 :     }
327 :     }
328 :    
329 :     if (open(TMP,">$FIG_Config::global/function.synonyms"))
330 :     {
331 :     foreach $from (sort keys(%tran))
332 :     {
333 :     print TMP "$from\t$tran{$from}\n";
334 :     }
335 :     close(TMP);
336 :     }
337 :     $_ = @$rules;
338 :     push(@$html,$cgi->h2("added $_ rules"));
339 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3