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

Annotation of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : mkubal 1.1 # -*- perl -*-
2 :    
3 :     use FIG;
4 : mkubal 1.2 use FigFam;
5 : mkubal 1.1 use FIG_Config;
6 :     use HTML;
7 :     use CGI;
8 :     my $cgi=new CGI;
9 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
10 :    
11 :     $fig = new FIG;
12 :     my $html = [];
13 :    
14 :     unshift(@$html, "<TITLE>Domain Analysis of Protein Sets</TITLE>\n");
15 :    
16 :     my $inputs;
17 :     if ($cgi->param('request') )
18 :     {
19 : mkubal 1.5 my $input =$cgi->param('set_of_pegs');
20 : mkubal 1.1 my @inputs = split("\n",$input);
21 :    
22 :     if ($cgi->upload('fileupload'))
23 :     {
24 :     my $fh=$cgi->upload('fileupload');
25 :     @inputs = <$fh> ;
26 :     }
27 :    
28 :     $given = [@inputs];
29 :     &analyze_domains($cgi,$fig,$given);
30 :    
31 :     }
32 : mkubal 1.4
33 :     elsif ($cgi->param('domain_search') )
34 :     {
35 :     #print STDERR "pressed\n";
36 :     my $query_domain =$cgi->param('query_domain');
37 :     &not_in_family_search($cgi,$fig,$query_domain);
38 :     }
39 :    
40 : mkubal 1.1 else
41 :     {
42 :     &show_initial($fig,$cgi,$html);
43 :     &HTML::show_page($cgi,$html,1);
44 :     exit;
45 :     }
46 :    
47 :     sub show_initial {
48 :     my ($fig,$cgi,$html)=@_;
49 :     push @$html,
50 :     $cgi->start_multipart_form(),
51 :     "<h3>Enter FigFam ID</h3>",
52 :     $cgi->textarea(-name=>"figfam_id", -rows=>1, -columns=>20),
53 :     $cgi->br,
54 :     "<h3>Enter set of pegs</h3>\n",
55 :     $cgi->textarea(-name=>"set_of_pegs", -rows=>10, -columns=>40),
56 :     $cgi->br,
57 :     "<h3>Upload File</h3>",
58 :     $cgi->filefield(-name=>"fileupload", -size=>50),
59 :     $cgi->br,
60 :     $cgi->hr,
61 :     $cgi->submit(-name=>'request', -value=>'Submit for Domain Analysis'),
62 :     $cgi->reset, $cgi->end_form;
63 :     return $html;
64 :     }
65 :    
66 : mkubal 1.4 sub not_in_family_search
67 :     {
68 :     my $html = [];
69 :     my ($cgi,$fig,$query_domain) =@_;
70 :     my $figfam_id = $cgi->param('figfam_id');
71 :     #print STDERR "fam_id:$figfam_id\n";
72 :     my $figfam = FigFam->new($fig,$figfam_id);
73 :     my $set = $figfam->pegs_of();
74 :     my %in_family;
75 :     foreach $member (@$set){
76 :     $in_family{$member} = 1;
77 :     }
78 :     my $key = $query_domain;
79 :     my @returns = $fig->get_attributes(undef,$key);
80 :    
81 :     push @$html,
82 :     "<br>",
83 :     "<h3>Pegs with $query_domain Not in $figfam_id</h3>",
84 :     "<table border><tr><td>PEG</td><td>FUNCTION</td></tr>";
85 :     my $count = scalar(@returns);
86 : mkubal 1.5 #print STDERR "count:$count\n";
87 : mkubal 1.4 foreach my $return (@returns){
88 :     my $peg = @$return[0];
89 : mkubal 1.5 #print STDERR "peg:$peg\n";
90 : mkubal 1.4 if(!$in_family{$peg}){
91 :     #print STDERR "peg:$peg\n";
92 :     my $function = $fig->function_of($peg);
93 :     push @$html,"<tr><td>$peg</td><td>$function</td></tr>";
94 :     }
95 :     }
96 :    
97 :     push @$html,"</table>";
98 :     &HTML::show_page($cgi,$html,1);
99 :     exit;
100 :    
101 :     }
102 :    
103 :    
104 : mkubal 1.1 sub analyze_domains
105 :     {
106 :     my ($cgi,$fig,$given) =@_;
107 : mkubal 1.5 my ($figfam_id,$figfam,$function,$set,$count);
108 : mkubal 1.1
109 : mkubal 1.5 if ($cgi->param('figfam_id')){
110 :     $figfam_id = $cgi->param('figfam_id');
111 :     $figfam = FigFam->new($fig,$figfam_id);
112 :     $function = $figfam->family_function();
113 :     $set = $figfam->pegs_of();
114 :     }
115 :    
116 :     else{
117 :     my @temp = ();
118 :     foreach $g (@$given){
119 :     if($g=~/(fig\|\d+.\d.peg.\d+)/){push(@temp,$1)}
120 :     }
121 :     $set = [@temp];
122 :     $figfam_id = "Arbitrary Set";
123 :     $function = "Mixed Set";
124 :     }
125 :     $count = scalar(@$set);
126 :    
127 : mkubal 1.3 my %peg_to_domain;
128 :     my %peg_to_score;
129 : mkubal 1.2 my %domain;
130 : mkubal 1.3 my %domain_location;
131 :     my %domain_length;
132 : mkubal 1.4
133 :     my %prob;
134 :     open(PROB,"/home/mkubal/Domain_Analysis/domain_probability_table.txt");
135 :     while($_ = <PROB>){
136 :     chomp($_);
137 :     @parts = split("\t",$_);
138 :     my $domain = $parts[0];
139 :     my $prob = $parts[1];
140 :     $prob{$domain} = $prob;
141 :     }
142 :     close(PROB);
143 :    
144 :     my %single;
145 :     open(IN,"/home/mkubal/Domain_Analysis/domain_to_single_family.txt");
146 :     while($_ = <IN>){
147 :     chomp($_);
148 :     @parts = split("\t",$_);
149 :     $single{$parts[0]} = $parts[1];
150 :     }
151 :     close(IN);
152 : mkubal 1.3
153 : mkubal 1.4 push @$html,
154 :     "<h3>Domain Analysis Results for $count pegs in $figfam_id</h3>",
155 :     "<h3>Family Function: $function</h3>",
156 :     "<br>";
157 :    
158 :     my @databases = ('CDD','PIR','PROSITE','PRODOM');
159 : mkubal 1.5 if($count > 0){
160 :     #print STDERR "some in set\n";
161 : mkubal 1.4 foreach my $db (@databases){
162 :     foreach $key (keys(%peg_to_score)){delete($peg_to_score{$key})}
163 :     foreach $key (keys(%peg_to_domain)){delete($peg_to_domain{$key})}
164 :     foreach $key (keys(%domain)){delete($domain{$key})}
165 :    
166 :     push @$html, "<table border>";
167 :     my @returns = $fig->get_attributes($set,$db);
168 :     foreach my $return (@returns){
169 :     my $peg = @$return[0];
170 :     my $seq = $fig->get_translation($peg);
171 :     my $length = length($seq);
172 : mkubal 1.3
173 : mkubal 1.4 if(@$return[2] =~/^(\d+\.\d+);(\d+)-(\d+)/){
174 :     my $score = $1;
175 :     my $begin = $2;
176 :     my $end = $3;
177 :     my $begin_percent = $begin/$length;
178 :     my $end_percent = $end/$length;
179 :    
180 :     if($peg_to_score{$peg}){
181 :     if($peg_to_score{$peg} > $score){
182 :     $peg_to_score{$peg} = $score;
183 :     if(@$return[1] =~/(\d+)/){
184 :     my $id = $1;
185 :     $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
186 :     }
187 :     }
188 :     }
189 :     else{
190 : mkubal 1.3 $peg_to_score{$peg} = $score;
191 :     if(@$return[1] =~/(\d+)/){
192 :     my $id = $1;
193 :     $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
194 :     }
195 :     }
196 :     }
197 : mkubal 1.4 }
198 :    
199 :     foreach $peg (keys(%peg_to_domain)){
200 :     my($id,$begin,$end,$length) = split("\t",$peg_to_domain{$peg});
201 :     my $number;
202 :     if($domain{$id}){
203 :     $number = $domain{$id};
204 :     $domain_begin{$id} = (($domain_begin{$id} * $number) + $begin)/($number + 1);
205 :     $domain_end{$id} = (($domain_end{$id} * $number) + $end)/($number + 1);
206 :     $domain_length{$id} = (($domain_length{$id} * $number) + $length)/($number + 1);
207 :     $domain{$id} = $number + 1;
208 :     }
209 : mkubal 1.3 else{
210 : mkubal 1.4 $domain{$id} = 1;
211 :     $domain_begin{$id} = $begin;
212 :     $domain_end{$id} = $end;
213 :     $domain_length{$id} = $length;
214 : mkubal 1.1 }
215 : mkubal 1.4 }
216 :    
217 :     push @$html,"<tr><td>$db Domain</td><td>Occurences</td><td>AVG Protein Length</td><td>AVG Begin</td><td>AVG End</td><td>Probability</td><td>Sole Family</td></tr>";
218 :    
219 :     foreach my $dom (keys(%domain)){
220 :     my ($length,$begin,$end);
221 :     my $instances = $domain{$dom};
222 :     if($domain_length{$dom} =~/^(\d+)/){$length = $1};
223 :     $begin = $domain_begin{$dom};
224 :     if($begin =~/(\d\.\d{3})/){$begin = $1}
225 :     $end = $domain_end{$dom};
226 :     if($end =~/(\d\.\d{3})/){$end = $1}
227 :     my $prob = $prob{$dom};
228 :     my $single_family = "multiple";
229 :     if($single{$dom}){$single_family = $single{$dom};}
230 :     my $link;
231 :     if($db eq "CDD"){$link ="http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=";}
232 :     elsif($db eq "PIR"){$link = "http://pir.georgetown.edu/cgi-bin/ipcSF?id=PIRSF";}
233 :     elsif($db eq "PRODOM"){$link = "http://prodom.prabi.fr/prodom/current/cgi-bin/request.pl?question=DBEN&query=PD";}
234 :     else{$link ="http://expasy.org/prosite/PS";}
235 :     my $tag = "<a href='$link$dom'>$dom</a>";
236 :     push @$html,"<tr><td>$tag</td><td>$instances</td><td>$length</td><td>$begin</td><td>$end</td><td>$prob</td><td>$single_family</td></tr>";
237 : mkubal 1.1 }
238 : mkubal 1.4 push @$html,"</table>";
239 : mkubal 1.3
240 : mkubal 1.2 }
241 : mkubal 1.4
242 : mkubal 1.3
243 : mkubal 1.1 push @$html,
244 : mkubal 1.4 $cgi->start_multipart_form(),
245 :     "<br><table border><tr><td>Search Pegs with Domain Not in Family</td><td>",
246 :     $cgi->textarea(-name=>"query_domain", -rows=>1, -columns=>15),
247 :     "</td><td>",
248 :     $cgi->submit(-name=>'domain_search', -value=>'Not In Family'),
249 :     "</td></tr></table>";
250 :     push @$html, "<input type='hidden' name='figfam_id' value='" . $cgi->param('figfam_id') . "'>";
251 : mkubal 1.1
252 :     &HTML::show_page($cgi,$html,1);
253 :     exit;
254 : mkubal 1.3 }
255 : mkubal 1.4
256 : mkubal 1.1 else{
257 :     push @$html,
258 :     "<h3>Must enter either FigFam ID or set of pegs</h3>";
259 :     &HTML::show_page($cgi,$html,1);
260 :     exit;
261 :     }
262 :     }
263 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3