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

Diff of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Thu Feb 22 20:45:16 2007 UTC revision 1.4, Thu May 24 20:09:42 2007 UTC
# Line 1  Line 1 
1  # -*- perl -*-  # -*- perl -*-
2    
3  use FIG;  use FIG;
4    use FigFam;
5  use FIG_Config;  use FIG_Config;
6  use HTML;  use HTML;
7  use CGI;  use CGI;
# Line 28  Line 29 
29    &analyze_domains($cgi,$fig,$given);    &analyze_domains($cgi,$fig,$given);
30    
31  }  }
32    
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  else  else
41  {  {
42    &show_initial($fig,$cgi,$html);    &show_initial($fig,$cgi,$html);
# Line 54  Line 63 
63      return $html;      return $html;
64  }  }
65    
66    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  sub analyze_domains  sub analyze_domains
105  {  {
106      my ($cgi,$fig,$given) =@_;      my ($cgi,$fig,$given) =@_;
107    
108      my $sops = $cgi->param('set_of_pegs');      my $sops = $cgi->param('set_of_pegs');
109      my $figfam_id = $cgi->param('figfam_id');      my $figfam_id = $cgi->param('figfam_id');
110      my @set,$count,%domain;      my $figfam = FigFam->new($fig,$figfam_id);
111        my $function = $figfam->family_function();
112        my %peg_to_domain;
113        my %peg_to_score;
114        my %domain;
115        my %domain_location;
116        my %domain_length;
117    
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    
139        my $set = $figfam->pegs_of();
140        my  $count = scalar(@$set);
141    
142        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      if($figfam_id){      if($figfam_id){
150          @set = $fig->proteins_in_family($figfam_id);          foreach my $db (@databases){
151          $count = scalar(@set);              foreach $key (keys(%peg_to_score)){delete($peg_to_score{$key})}
152          foreach $peg(@set){              foreach $key (keys(%peg_to_domain)){delete($peg_to_domain{$key})}
153              $returns = $fig->get_attributes($peg);              foreach $key (keys(%domain)){delete($domain{$key})}
154              foreach $return (@$returns){  
155                  if(@$return[1] =~/CDD::(\d+)/){              push @$html, "<table border>";
156                      $id = $1;              my @returns = $fig->get_attributes($set,$db);
157                      if($domain{$id}){$domain{$id} = $domain{$id} + 1;}              foreach my $return (@returns){
158                      else{$domain{$id} = 1;}                  my $peg = @$return[0];
159                    my $seq = $fig->get_translation($peg);
160                    my $length = length($seq);
161    
162                    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                            $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          }          }
187    
188          push @$html,              foreach $peg (keys(%peg_to_domain)){
189          "<h3>Domain Analysis Results</h3>",                  my($id,$begin,$end,$length) = split("\t",$peg_to_domain{$peg});
190          "<br>",                  my $number;
191          "<table>";                  if($domain{$id}){
192          foreach $dom (keys(%domain)){                      $number = $domain{$id};
193              $instances = $domain{$dom};                      $domain_begin{$id} = (($domain_begin{$id} * $number) + $begin)/($number + 1);
194              push @html,"<tr><td>$dom</td><td>$instances</td></tr>";                      $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                    else{
199                        $domain{$id} = 1;
200                        $domain_begin{$id} = $begin;
201                        $domain_end{$id} = $end;
202                        $domain_length{$id} = $length;
203                    }
204                }
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                }
227                push @$html,"</table>";
228    
229          }          }
230    
231    
232          push @$html,          push @$html,
233          "</table>";          $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    
241          &HTML::show_page($cgi,$html,1);          &HTML::show_page($cgi,$html,1);
242          exit;          exit;
243      }      }
244    
245      else{      else{
246          push @$html,          push @$html,
247          "<h3>Must enter either FigFam ID or set of pegs</h3>";          "<h3>Must enter either FigFam ID or set of pegs</h3>";
248          &HTML::show_page($cgi,$html,1);          &HTML::show_page($cgi,$html,1);
249          exit;          exit;
250      }      }
   
251  }  }
252    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3