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

Annotation of /FigWebServices/get_expert_2c.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (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 : overbeek 1.7 eval(join("",`cat /tmp/exp_2c_parms`));
33 : overbeek 1.1 $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 : overbeek 1.7 if (open(TMP,">/tmp/exp_2c_parms"))
50 : overbeek 1.1 {
51 :     print TMP &Dumper($cgi);
52 :     close(TMP);
53 :     }
54 :     }
55 :     exit;
56 :     }
57 :     my($genome);
58 :    
59 :     my $html = [];
60 :     unshift @$html, "<TITLE>Get Solid Assertions</TITLE>\n";
61 :    
62 : overbeek 1.2 my $user = $cgi->param('user');
63 : overbeek 1.1 my $subsys = $cgi->param('subsystem');
64 :     my $role = $cgi->param('role');
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 && (! $role))
80 :     {
81 :     my @roles = &roles_for_sub($cgi,$html,$fig,$subsys);;
82 :     if (@roles > 0)
83 :     {
84 :     &format_roles($cgi,$html,$fig,\@roles,$subsys);
85 :     }
86 :     else
87 :     {
88 :     push(@$html,$cgi->h1('Sorry, no roles defined'));
89 :     }
90 :     }
91 :     elsif ($subsys && $role && ($cgi->param('request') eq "show_assertions"))
92 :     {
93 :     &format_assertions($cgi,$html,$fig,$subsys,$role);
94 :     }
95 :     elsif ($subsys && $role && ($cgi->param('request') eq "2c_assertions"))
96 :     {
97 :     &format_2c($cgi,$html,$fig);
98 :     }
99 :     else
100 :     {
101 :     push(@$html,$cgi->h1('invalid parameters'));
102 :     }
103 :    
104 :     &HTML::show_page($cgi,$html);
105 :    
106 :     sub format_ssa_table {
107 :     my($cgi,$html,$ssaP) = @_;
108 :    
109 :     push(@$html, $cgi->start_form(-action => "get_expert_2c.cgi",
110 :     -method => 'post'),
111 : overbeek 1.2 $cgi->hidden(-name => 'user', -value => $user, -override => 1),
112 : overbeek 1.1 $cgi->hidden(-name => 'request', -value => 'show_variants', -override => 1),
113 :     $cgi->scrolling_list( -name => 'subsystem',
114 :     -values => [ map { $_->[0] } @$ssaP ],
115 :     -size => 10
116 :     ),
117 :     $cgi->br,
118 :     $cgi->submit( 'Pick One' ),
119 :     $cgi->end_form
120 :     );
121 :     }
122 :    
123 :     sub existing_subsystem_annotations {
124 :     my($ssa,$name);
125 :     my @ssa = ();
126 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
127 :     {
128 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
129 :     closedir(SSA);
130 :     }
131 :     return sort { $a->[0] cmp $b->[0] } @ssa;
132 :     }
133 :    
134 :     sub curator {
135 :     my($ssa) = @_;
136 :     my($who) = "";
137 :    
138 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
139 :     {
140 :     $_ = <DATA>;
141 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
142 :     {
143 :     $who = $1;
144 :     }
145 :     close(DATA);
146 :     }
147 :     return $who;
148 :     }
149 :    
150 :     sub roles_for_sub {
151 :     my($cgi,$html,$fig,$subsys) = @_;
152 :    
153 :     my $sub = $fig->get_subsystem($subsys);
154 :     my @roles = $sub->get_roles;
155 :     return @roles;
156 :     }
157 :    
158 :     sub format_roles {
159 :     my($cgi,$html,$fig,$roles,$subsys) = @_;
160 :    
161 :     push(@$html, $cgi->start_form(-action => "get_expert_2c.cgi",
162 :     -method => 'post'),
163 : overbeek 1.2 $cgi->hidden(-name => 'user', -value => $user, -override => 1),
164 : overbeek 1.1 $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
165 :     $cgi->hidden(-name => 'request', -value => 'show_assertions', -override => 1),
166 :     $cgi->scrolling_list( -name => 'role',
167 :     -values => $roles,
168 :     -size => 10
169 :     ),
170 :     $cgi->br,
171 : overbeek 1.6 $cgi->br,
172 :     $cgi->br,
173 :     'Require Clustering with ',
174 :     $cgi->textfield(-name => "clusters_with", -size => 3, -value => 0),
175 :     $cgi->br,
176 : overbeek 1.1 $cgi->submit( 'Show Assertions to Pick From' ),
177 :     $cgi->end_form
178 :     );
179 :     }
180 :    
181 :     sub format_assertions {
182 :     my($cgi,$html,$fig,$subsys,$role) = @_;
183 :    
184 : overbeek 1.6 my $clusters_with = $cgi->param('clusters_with');
185 :     my $subsysQ = quotemeta $subsys;
186 : overbeek 1.1 push(@$html, $cgi->start_form(-action => "get_expert_2c.cgi",
187 :     -method => 'post'),
188 : overbeek 1.2 $cgi->hidden(-name => 'user', -value => $user, -override => 1),
189 : overbeek 1.1 $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
190 :     $cgi->hidden(-name => 'role', -value => $role, -override => 1),
191 :     $cgi->hidden(-name => 'request', -value => '2c_assertions', -override => 1)
192 :     );
193 :    
194 :     my $sub = $fig->get_subsystem($subsys);
195 :     my @genomes = $sub->get_genomes;
196 : overbeek 1.3 my %variant_codes;
197 :     foreach my $genome (@genomes)
198 :     {
199 :     my $var = $sub->get_variant_code_for_genome($genome);
200 :     $variant_codes{$genome} = $var;
201 :     }
202 :    
203 : overbeek 1.6 my $col_hdrs = ['Solid','Possibly Truncated','Duplicates','Length','variant code','PEG','Clusters with','Genome','Function'];
204 : overbeek 1.1 my $tab1 = [];
205 :     my $tab2 = [];
206 :    
207 :     my @all_pegs = ();
208 :    
209 :     my($peg,$ln);
210 :     foreach my $genome (@genomes)
211 :     {
212 :     my @pegs = $sub->get_pegs_from_cell($genome,$role);
213 :     if (@pegs > 0)
214 :     {
215 :     push(@all_pegs,[map { $peg = $_; $ln = length($fig->get_translation($peg)); [$peg,$ln] } @pegs ]);
216 :     }
217 :     }
218 :    
219 :     my $tot = 0;
220 :     my $n = 0;
221 :     foreach my $gset (@all_pegs)
222 :     {
223 :     foreach my $tuple (@$gset)
224 :     {
225 :     ($peg,$ln) = @$tuple;
226 :     $tot += $ln;
227 :     $n++;
228 :     }
229 :     }
230 : overbeek 1.7 my $avg = ($n > 0) ? int($tot/$n) : 1000000;
231 : overbeek 1.1
232 :     foreach my $gset (@all_pegs)
233 :     {
234 :     foreach my $tuple (@$gset)
235 :     {
236 :     ($peg,$ln) = @$tuple;
237 :    
238 :     my $trunc = $fig->possibly_truncated($peg) ? "yes" : '&nbsp;';
239 :     my $dup = (@$gset > 1) ? scalar @$gset : '&nbsp;';
240 : overbeek 1.3 my $genome = &FIG::genome_of($peg);
241 :     my $gs = $fig->genus_species($genome);
242 : overbeek 1.1 my $func = $fig->function_of($peg);
243 : overbeek 1.4 my $bad_ln = (abs($ln - $avg) > (0.2 * $avg));
244 : overbeek 1.6 my @tmp = map { ($_->[2] =~ /^icw\((\d+)\);$subsysQ/) ? $1 : () } $fig->get_attributes($peg,'evidence_code');
245 :     my $icw = (@tmp > 0) ? $tmp[0] : 0;
246 :    
247 : overbeek 1.3 my $solid = (($variant_codes{$genome} =~ /^(0|-1)$/) ||
248 : overbeek 1.4 (($trunc eq "yes") || (@$gset > 1) || $bad_ln)) ? "no" : "yes";
249 : overbeek 1.3
250 : overbeek 1.6 my $checked = (($solid eq "yes") && ((! $clusters_with) || ($icw >= $clusters_with))) ? 1 : 0;
251 :    
252 : overbeek 1.1 my $check = $cgi->checkbox(-name => 'checked',
253 :     -value => $peg,
254 :     -checked => $checked,
255 :     -override => 1,
256 :     -label => '');
257 :    
258 :     my $link = &HTML::fid_link($cgi,$peg);
259 :    
260 : overbeek 1.6 if (($solid eq "yes") && ((! $clusters_with) || ($icw >= $clusters_with)))
261 : overbeek 1.1 {
262 : overbeek 1.6 push(@$tab1,[$check,$trunc,$dup,$ln,$variant_codes{$genome},$link,$icw,$gs,$func]);
263 : overbeek 1.1 }
264 :     else
265 :     {
266 : overbeek 1.4 push(@$tab2,[$check,
267 :     ($trunc eq "yes") ? [$trunc,'td bgcolor=yellow'] : $trunc,
268 :     ($dup =~ /^[0-9]/) ? [$dup,'td bgcolor=yellow'] : $dup,
269 :     $bad_ln ? [$ln,'td bgcolor=yellow'] : $ln,
270 :     ($variant_codes{$genome} =~ /^(0|-1)$/) ?
271 :     [$variant_codes{$genome},'td bgcolor=yellow'] :
272 :     $variant_codes{$genome},
273 : overbeek 1.6 $link,$icw,$gs,$func
274 : overbeek 1.4 ]);
275 : overbeek 1.1 }
276 :     }
277 :     }
278 :    
279 : overbeek 1.4 $tab1 = [sort { $a->[6] cmp $b->[6] } @$tab1];
280 :     $tab2 = [sort { $a->[6] cmp $b->[6] } @$tab2];
281 : overbeek 1.2
282 : overbeek 1.1 push(@$html,&HTML::make_table($col_hdrs,$tab1,"Solid: Avg Length = $avg"));
283 :    
284 :     push(@$html,&HTML::make_table($col_hdrs,$tab2,"Maybe Not So Solid: Avg Length = $avg"));
285 :    
286 :     push(@$html, $cgi->br,
287 : overbeek 1.5 $cgi->submit( 'Show 3-column Assertion Table [Id, Function, genus/specie]' ),
288 : overbeek 1.1 $cgi->end_form
289 :     );
290 :    
291 :     }
292 :    
293 :     sub format_2c {
294 :     my($cgi,$html,$fig) = @_;
295 :    
296 :     my @checked = $cgi->param('checked');
297 :     push(@$html,"<pre>");
298 :     foreach my $peg (@checked)
299 :     {
300 :     my $func = $fig->function_of($peg);
301 : overbeek 1.5 my $org = $fig->genus_species(&FIG::genome_of($peg));
302 :     push(@$html,"$peg\t$func\t$org\n");
303 : overbeek 1.1 }
304 :     push(@$html,"</pre>");
305 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3