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

View of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (annotate)
Thu May 24 20:54:25 2007 UTC (12 years, 6 months ago) by mkubal
Branch: MAIN
Changes since 1.4: +24 -13 lines
052407

# -*- perl -*-

use FIG;
use FigFam;
use FIG_Config;
use HTML;
use CGI;
my $cgi=new CGI;
use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.

$fig = new FIG;
my $html = [];

unshift(@$html, "<TITLE>Domain Analysis of Protein Sets</TITLE>\n");

my $inputs;
if ($cgi->param('request') ) 
{
  my $input =$cgi->param('set_of_pegs');
  my @inputs = split("\n",$input);

  if ($cgi->upload('fileupload'))
  {
     my $fh=$cgi->upload('fileupload');
     @inputs = <$fh> ;
  }

  $given = [@inputs];
  &analyze_domains($cgi,$fig,$given); 
 
}

elsif ($cgi->param('domain_search') ) 
{
  #print STDERR "pressed\n";   
  my $query_domain =$cgi->param('query_domain');
  &not_in_family_search($cgi,$fig,$query_domain); 
}

else
{
  &show_initial($fig,$cgi,$html);
  &HTML::show_page($cgi,$html,1);
  exit;
}

sub show_initial {
    my ($fig,$cgi,$html)=@_;
    push @$html, 
    $cgi->start_multipart_form(),
    "<h3>Enter FigFam ID</h3>",
    $cgi->textarea(-name=>"figfam_id", -rows=>1, -columns=>20),
    $cgi->br,
    "<h3>Enter set of pegs</h3>\n",
    $cgi->textarea(-name=>"set_of_pegs", -rows=>10, -columns=>40), 
    $cgi->br,  
    "<h3>Upload File</h3>",
    $cgi->filefield(-name=>"fileupload", -size=>50),
    $cgi->br,
    $cgi->hr,
    $cgi->submit(-name=>'request', -value=>'Submit for Domain Analysis'),
    $cgi->reset, $cgi->end_form;
    return $html;
}

sub not_in_family_search 
{
    my $html = [];
    my ($cgi,$fig,$query_domain) =@_;
    my $figfam_id = $cgi->param('figfam_id');
    #print STDERR "fam_id:$figfam_id\n";
    my $figfam = FigFam->new($fig,$figfam_id);
    my $set = $figfam->pegs_of();
    my %in_family;
    foreach $member (@$set){
	$in_family{$member} = 1;
    }
    my $key = $query_domain;
    my @returns = $fig->get_attributes(undef,$key);
    
    push @$html,
    "<br>",
    "<h3>Pegs with $query_domain Not in $figfam_id</h3>",
    "<table border><tr><td>PEG</td><td>FUNCTION</td></tr>"; 
    my $count = scalar(@returns);
    #print STDERR "count:$count\n";
    foreach my $return (@returns){
	my $peg = @$return[0];
	#print STDERR "peg:$peg\n";
	if(!$in_family{$peg}){
	    #print STDERR "peg:$peg\n";
	    my $function = $fig->function_of($peg);
	    push @$html,"<tr><td>$peg</td><td>$function</td></tr>";
	}
    }
    
    push @$html,"</table>";
    &HTML::show_page($cgi,$html,1);
    exit;

}


sub analyze_domains 
{
    my ($cgi,$fig,$given) =@_;
    my ($figfam_id,$figfam,$function,$set,$count);

    if ($cgi->param('figfam_id')){
	$figfam_id = $cgi->param('figfam_id');
	$figfam = FigFam->new($fig,$figfam_id);
	$function = $figfam->family_function();
	$set = $figfam->pegs_of();
    }
    
    else{
        my @temp = ();
	foreach $g (@$given){
	    if($g=~/(fig\|\d+.\d.peg.\d+)/){push(@temp,$1)}
	}
	$set = [@temp];
	$figfam_id = "Arbitrary Set";
	$function = "Mixed Set";
    }
    $count = scalar(@$set);
    
    my %peg_to_domain;
    my %peg_to_score; 
    my %domain;
    my %domain_location;
    my %domain_length;

    my %prob;
    open(PROB,"/home/mkubal/Domain_Analysis/domain_probability_table.txt");
    while($_ = <PROB>){
	chomp($_);
	@parts = split("\t",$_);	
	my $domain = $parts[0];
	my $prob = $parts[1];
	$prob{$domain} = $prob;
    }
    close(PROB);
    
    my %single;
    open(IN,"/home/mkubal/Domain_Analysis/domain_to_single_family.txt");
    while($_ = <IN>){
	chomp($_);
	@parts = split("\t",$_);
	$single{$parts[0]} = $parts[1];
    }
    close(IN);
    
    push @$html,
    "<h3>Domain Analysis Results for $count pegs in $figfam_id</h3>",
    "<h3>Family Function: $function</h3>",
    "<br>";
    
    my @databases = ('CDD','PIR','PROSITE','PRODOM');
    if($count > 0){
	#print STDERR "some in set\n";
	foreach my $db (@databases){
	    foreach $key (keys(%peg_to_score)){delete($peg_to_score{$key})}
	    foreach $key (keys(%peg_to_domain)){delete($peg_to_domain{$key})}
	    foreach $key (keys(%domain)){delete($domain{$key})}

	    push @$html, "<table border>";
	    my @returns = $fig->get_attributes($set,$db);
	    foreach my $return (@returns){
		my $peg = @$return[0];
		my $seq = $fig->get_translation($peg);
		my $length = length($seq);
		
		if(@$return[2] =~/^(\d+\.\d+);(\d+)-(\d+)/){
		    my $score = $1;
		    my $begin = $2;
		    my $end = $3;
		    my $begin_percent = $begin/$length;
		    my $end_percent = $end/$length;
		    
		    if($peg_to_score{$peg}){
			if($peg_to_score{$peg} > $score){
			    $peg_to_score{$peg} = $score;
			    if(@$return[1] =~/(\d+)/){
				my $id = $1;
				$peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
			    }
			}
		    }
		    else{
			$peg_to_score{$peg} = $score;
			if(@$return[1] =~/(\d+)/){
			    my $id = $1;
			    $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
			}
		    }
		}
	    }
	    
	    foreach $peg (keys(%peg_to_domain)){
		my($id,$begin,$end,$length) = split("\t",$peg_to_domain{$peg});
		my $number;
		if($domain{$id}){
		    $number = $domain{$id};
		    $domain_begin{$id} = (($domain_begin{$id} * $number) + $begin)/($number + 1);
		    $domain_end{$id} = (($domain_end{$id} * $number) + $end)/($number + 1);    
		    $domain_length{$id} = (($domain_length{$id} * $number) + $length)/($number + 1);    
		    $domain{$id} = $number + 1;
		}
		else{
		    $domain{$id} = 1;
		    $domain_begin{$id} = $begin;
		    $domain_end{$id} = $end;
		    $domain_length{$id} = $length;
		}
	    }	
	    
	    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>";
	    
	    foreach my $dom (keys(%domain)){
		my ($length,$begin,$end);
		my $instances = $domain{$dom};
		if($domain_length{$dom} =~/^(\d+)/){$length = $1};
		$begin = $domain_begin{$dom};
		if($begin =~/(\d\.\d{3})/){$begin = $1}
		$end = $domain_end{$dom};
		if($end =~/(\d\.\d{3})/){$end = $1}
		my $prob = $prob{$dom};
		my $single_family = "multiple";
		if($single{$dom}){$single_family = $single{$dom};}
		my $link;
		if($db eq "CDD"){$link ="http://0-www.ncbi.nlm.nih.gov.library.vu.edu.au:80/Structure/cdd/cddsrv.cgi?uid=";}
		elsif($db eq "PIR"){$link = "http://pir.georgetown.edu/cgi-bin/ipcSF?id=PIRSF";}
                elsif($db eq "PRODOM"){$link = "http://prodom.prabi.fr/prodom/current/cgi-bin/request.pl?question=DBEN&query=PD";}  
		else{$link ="http://expasy.org/prosite/PS";}
		my $tag = "<a href='$link$dom'>$dom</a>";
		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>";
	    }
	    push @$html,"</table>";
	    
	}
    

	push @$html,
	$cgi->start_multipart_form(),
	"<br><table border><tr><td>Search Pegs with Domain Not in Family</td><td>",
	$cgi->textarea(-name=>"query_domain", -rows=>1, -columns=>15),
	"</td><td>",
	$cgi->submit(-name=>'domain_search', -value=>'Not In Family'),
	"</td></tr></table>";
	push @$html, "<input type='hidden' name='figfam_id' value='" . $cgi->param('figfam_id') . "'>";
	
	&HTML::show_page($cgi,$html,1);
	exit;
    }   
 
    else{
	push @$html, 
	"<h3>Must enter either FigFam ID or set of pegs</h3>";
	&HTML::show_page($cgi,$html,1);
	exit;
    }
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3