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

Annotation of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (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 :     my $input =$cgi->param('proteins');
20 :     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 :     print STDERR "count:$count\n";
87 :     foreach my $return (@returns){
88 :     my $peg = @$return[0];
89 :     print STDERR "peg:$peg\n";
90 :     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 :    
108 :     my $sops = $cgi->param('set_of_pegs');
109 :     my $figfam_id = $cgi->param('figfam_id');
110 : mkubal 1.2 my $figfam = FigFam->new($fig,$figfam_id);
111 : mkubal 1.3 my $function = $figfam->family_function();
112 :     my %peg_to_domain;
113 :     my %peg_to_score;
114 : mkubal 1.2 my %domain;
115 : mkubal 1.3 my %domain_location;
116 :     my %domain_length;
117 : mkubal 1.4
118 :     my %prob;
119 :     open(PROB,"/home/mkubal/Domain_Analysis/domain_probability_table.txt");
120 :     while($_ = <PROB>){
121 :     chomp($_);
122 :     @parts = split("\t",$_);
123 :     my $domain = $parts[0];
124 :     my $prob = $parts[1];
125 :     $prob{$domain} = $prob;
126 :     #print STDERR "prob:$domain $prob";
127 :     }
128 :     close(PROB);
129 :    
130 :     my %single;
131 :     open(IN,"/home/mkubal/Domain_Analysis/domain_to_single_family.txt");
132 :     while($_ = <IN>){
133 :     chomp($_);
134 :     @parts = split("\t",$_);
135 :     $single{$parts[0]} = $parts[1];
136 :     }
137 :     close(IN);
138 : mkubal 1.3
139 :     my $set = $figfam->pegs_of();
140 :     my $count = scalar(@$set);
141 :    
142 : mkubal 1.4 push @$html,
143 :     "<h3>Domain Analysis Results for $count pegs in $figfam_id</h3>",
144 :     "<h3>Family Function: $function</h3>",
145 :     "<br>";
146 :    
147 :    
148 :     my @databases = ('CDD','PIR','PROSITE','PRODOM');
149 : mkubal 1.1 if($figfam_id){
150 : mkubal 1.4 foreach my $db (@databases){
151 :     foreach $key (keys(%peg_to_score)){delete($peg_to_score{$key})}
152 :     foreach $key (keys(%peg_to_domain)){delete($peg_to_domain{$key})}
153 :     foreach $key (keys(%domain)){delete($domain{$key})}
154 :    
155 :     push @$html, "<table border>";
156 :     my @returns = $fig->get_attributes($set,$db);
157 :     foreach my $return (@returns){
158 :     my $peg = @$return[0];
159 :     my $seq = $fig->get_translation($peg);
160 :     my $length = length($seq);
161 : mkubal 1.3
162 : mkubal 1.4 if(@$return[2] =~/^(\d+\.\d+);(\d+)-(\d+)/){
163 :     my $score = $1;
164 :     my $begin = $2;
165 :     my $end = $3;
166 :     my $begin_percent = $begin/$length;
167 :     my $end_percent = $end/$length;
168 :    
169 :     if($peg_to_score{$peg}){
170 :     if($peg_to_score{$peg} > $score){
171 :     $peg_to_score{$peg} = $score;
172 :     if(@$return[1] =~/(\d+)/){
173 :     my $id = $1;
174 :     $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
175 :     }
176 :     }
177 :     }
178 :     else{
179 : mkubal 1.3 $peg_to_score{$peg} = $score;
180 :     if(@$return[1] =~/(\d+)/){
181 :     my $id = $1;
182 :     $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
183 :     }
184 :     }
185 :     }
186 : mkubal 1.4 }
187 :    
188 :     foreach $peg (keys(%peg_to_domain)){
189 :     my($id,$begin,$end,$length) = split("\t",$peg_to_domain{$peg});
190 :     my $number;
191 :     if($domain{$id}){
192 :     $number = $domain{$id};
193 :     $domain_begin{$id} = (($domain_begin{$id} * $number) + $begin)/($number + 1);
194 :     $domain_end{$id} = (($domain_end{$id} * $number) + $end)/($number + 1);
195 :     $domain_length{$id} = (($domain_length{$id} * $number) + $length)/($number + 1);
196 :     $domain{$id} = $number + 1;
197 :     }
198 : mkubal 1.3 else{
199 : mkubal 1.4 $domain{$id} = 1;
200 :     $domain_begin{$id} = $begin;
201 :     $domain_end{$id} = $end;
202 :     $domain_length{$id} = $length;
203 : mkubal 1.1 }
204 : mkubal 1.4 }
205 :    
206 :     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>";
207 :    
208 :     foreach my $dom (keys(%domain)){
209 :     my ($length,$begin,$end);
210 :     my $instances = $domain{$dom};
211 :     if($domain_length{$dom} =~/^(\d+)/){$length = $1};
212 :     $begin = $domain_begin{$dom};
213 :     if($begin =~/(\d\.\d{3})/){$begin = $1}
214 :     $end = $domain_end{$dom};
215 :     if($end =~/(\d\.\d{3})/){$end = $1}
216 :     my $prob = $prob{$dom};
217 :     my $single_family = "multiple";
218 :     if($single{$dom}){$single_family = $single{$dom};}
219 :     my $link;
220 :     if($db eq "CDD"){$link ="http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=";}
221 :     elsif($db eq "PIR"){$link = "http://pir.georgetown.edu/cgi-bin/ipcSF?id=PIRSF";}
222 :     elsif($db eq "PRODOM"){$link = "http://prodom.prabi.fr/prodom/current/cgi-bin/request.pl?question=DBEN&query=PD";}
223 :     else{$link ="http://expasy.org/prosite/PS";}
224 :     my $tag = "<a href='$link$dom'>$dom</a>";
225 :     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>";
226 : mkubal 1.1 }
227 : mkubal 1.4 push @$html,"</table>";
228 : mkubal 1.3
229 : mkubal 1.2 }
230 : mkubal 1.4
231 : mkubal 1.3
232 : mkubal 1.1 push @$html,
233 : mkubal 1.4 $cgi->start_multipart_form(),
234 :     "<br><table border><tr><td>Search Pegs with Domain Not in Family</td><td>",
235 :     $cgi->textarea(-name=>"query_domain", -rows=>1, -columns=>15),
236 :     "</td><td>",
237 :     $cgi->submit(-name=>'domain_search', -value=>'Not In Family'),
238 :     "</td></tr></table>";
239 :     push @$html, "<input type='hidden' name='figfam_id' value='" . $cgi->param('figfam_id') . "'>";
240 : mkubal 1.1
241 :     &HTML::show_page($cgi,$html,1);
242 :     exit;
243 : mkubal 1.3 }
244 : mkubal 1.4
245 : mkubal 1.1 else{
246 :     push @$html,
247 :     "<h3>Must enter either FigFam ID or set of pegs</h3>";
248 :     &HTML::show_page($cgi,$html,1);
249 :     exit;
250 :     }
251 :     }
252 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3