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

Annotation of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3