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

View of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (download) (annotate)
Fri May 25 16:40:29 2007 UTC (12 years, 5 months ago) by mkubal
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.5: +23 -14 lines
added ss info

# -*- 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') ) 
{
  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>ORGANISM</td><td>PEG</td><td>SUBSYSTEM</td><td>FUNCTION</td></tr>"; 
    my $count = scalar(@returns);
    #print STDERR "count:$count\n";
    foreach my $return (@returns){
	my $peg = @$return[0];
	if(!$in_family{$peg}){
	    my $peg_link = &HTML::fid_link($cgi,$peg);
	    my $genome_id;
	    if($peg =~/fig\|(\d+.\d).peg.\d+/){
		$genome_id = $1;
	    }
	    
	    my $organism = $fig->genus_species($genome_id);
	    my @subsystems = $fig->subsystems_for_peg($peg);
	    #my @ss_list = map {$_->[0]} @subsystems;
	    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;
	    my $ss_string = join(" ",@ss_list);
	    my $function = $fig->function_of($peg);
	    push @$html,"<tr><td>$organism</td><td>$peg_link</td><td>$ss_string</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, "<p>","<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,$link_text;
		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";}
		elsif($db eq "PIR"){$link = "http://pir.georgetown.edu/cgi-bin/ipcSF?id=PIRSF";$link_text="PIR::PIRSF$dom";}
                elsif($db eq "PRODOM"){$link = "http://prodom.prabi.fr/prodom/current/cgi-bin/request.pl?question=DBEN&query=PD";$link_text="PRODOM::PD$dom";}  
		else{$link ="http://expasy.org/prosite/PS";$link_text ="PROSITE::PS$dom";}
		my $tag = "<a href='$link$dom'>$link_text</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,"</p>";
	}
    

	push @$html,
	"<h3>Search for Pegs with Domain Not in Family</h3>",
	$cgi->start_multipart_form(),
	"<br><table border><tr><td>Enter Domain using format of Database::ID </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