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

View of /FigWebServices/find_ss_genes.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Fri Oct 27 16:28:40 2006 UTC (13 years, 3 months ago) by overbeek
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.3: +64 -7 lines
added code to show connections between subsystems

# -*- perl -*-
#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


use FIG;
my $fig = new FIG;

use HTML;
use CGI;
my $cgi = new CGI;

my $user = $cgi->param('user');
$fig->set_user($user);

if (0)
{   
    my $VAR1;
    eval(join("",`cat /tmp/find_ss_genes_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
        print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
        if (open(TMP,">/tmp/find_ss_genes_parms"))
        {
            print TMP &Dumper($cgi);
            close(TMP);
        }
    }
    exit;
}

my $html = [];
unshift @$html, "<TITLE>Find SS Genes</TITLE>\n";

my $genome = $cgi->param('genome');
my $request = $cgi->param('request');
if (! $request)
{
    &show_initial($fig,$cgi,$html);
}   
elsif ($request eq "show_genes")
{   
    @genomes = map { ($_ =~ /(\d+\.\d+)\s*$/) ? $1 : () } $cgi->param('genome');
    if (@genomes == 0)
    {
	push (@$html,$cgi->h1('You need to pick one or more genomes'));
    }
    else
    {
	&process_request($fig,$cgi,$html,\@genomes);
    }
}

&HTML::show_page($cgi,$html);

sub process_request {
    my($fig,$cgi,$html,$genomes) = @_;

    if ($cgi->param('Genes in cluster, but not a subsystem'))
    {
	my @poss = ();
	foreach $genome (@$genomes)
	{
	    push(@poss,&process_one_genome($fig,$cgi,$html,$genome));
	}
	my @tab = map { my($sc,$sc1,$peg) = @$_; [$sc,$sc1,&link($cgi,$peg),scalar $fig->function_of($peg)] } sort { ($b->[0] <=> $a->[0]) or ($b->[1] <=> $a->[1]) } @poss;
	push(@$html,&HTML::make_table(['Coupling Score','Size of Cluster','PEG','Function'],\@tab,'Best Hits'));
    }
    elsif ($cgi->param('Potentially Related Subsystems [cluster]'))
    {
	@hits =&process_split_ss($fig,$genomes);
	my @tab = map { my($peg1,$peg2,$sc,$key) = @$_; [$sc,&link($cgi,$peg1),$peg2,split(/\t/,$key)] } sort { ($b->[2] <=> $a->[2]) or ($b->[0] cmp $a->[0]) } @hits;
	push(@$html,&HTML::make_table(['Coupling Score','PEG1','PEG2','Sub1','Sub2'],\@tab,'Best Hits'));
    }
}

sub process_split_ss {
    my($fig,$genomes) = @_;

    my @hits = ();
    my %seen;
    foreach my $genome (@$genomes)
    {
	foreach my $peg ($fig->all_features($genome,'peg'))
	{
	    my @sub1 = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg);

	    if (@sub1 > 0)
	    {
		my %sub1 = map { $_ => 1 } @sub1;
		my @coupled = sort { $b->[1] <=> $a->[1] } grep { $_->[1] >= 10 } $fig->coupled_to($peg);
		if (@coupled > 0)
		{
		    foreach my $tuple (@coupled)
		    {
			my($peg1,$sc1) = @$tuple;
			my @sub2 = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg1);
			my @comm = grep { $sub1{$_} } @sub2;

			if ((@sub2 > 0) && (@comm == 0))
			{
			    foreach my $x1 (@sub1)
			    {
				foreach my $x2 (@sub2)
				{
				    my $key = join("\t",sort ($x1,$x2));
				    if ((! $seen{$key}) || ($seen{$key}->[2] < $sc1))
				    {
					$seen{$key} = [$peg,@$tuple];
				    }
				}
			    }
			}
		    }
		}
	    }
	}
    }
    foreach my $key (sort { $seen{$b}->[2] <=> $seen{$a}->[2] } keys(%seen))
    {
	push(@hits,[@{$seen{$key}},$key]);
    }
    return @hits;
}

sub process_one_genome {
    my($fig,$cgi,$html,$genome) = @_;

    my @hits = ();
    foreach $peg ($fig->all_features($genome,'peg'))
    {
        my @tmp = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($peg);
        if (@tmp == 0)
        {
#           print STDERR "$peg is not in SS\n";
            my @coupled = sort { $b->[1] <=> $a->[1] } grep { $_->[1] >= 5 } $fig->coupled_to($peg);
	    
            if ((@coupled > 0) && ($coupled[0]->[1] > 5))
            {
		my %in = map { $_->[0] => 1 } @coupled;
		for (my $i=0; ($i < @coupled); $i++) 
		{
		    my @tmp = grep { $_->[1] >= 5 } $fig->coupled_to($coupled[$i]->[0]);
		    foreach my $tuple (@tmp)
		    {
			my($peg1,$sc) = @$tuple;
			if (! $in{$peg1})
			{
			    push(@coupled,$tuple);
			    $in{$peg1} = 1;
			}
		    }
		}
		
                push(@hits,[$coupled[0]->[1],scalar keys(%in),$peg]);
            }
        }
    }
    return @hits;
}

sub link {
    my($cgi,$peg) = @_;

    my $user = $cgi->param('user');
    return "<a href=protein.cgi?user=$user&prot=$peg> $peg </a>";
}

sub show_initial {
    my($fig,$cgi,$html) = @_;

    @genomes = sort map { $org = $_; $fig->genus_species($org) . ": $org" } $fig->genomes('complete');
    push(@$html, $cgi->start_form(-action => "find_ss_genes.cgi",
                                  -method => 'post'),
                 $cgi->hidden(-name => 'request', -value => 'show_genes', -override => 1),
                 $cgi->hidden(-name => 'user', -value=>$user),
                 $cgi->scrolling_list( -name   => 'genome',
                                       -values => \@genomes,
                                       -size   => 10,
				       -multiple => 1
                                       ),
                 $cgi->br,
                 $cgi->submit( 'Genes in cluster, but not a subsystem' ),
                 $cgi->submit( 'Potentially Related Subsystems [cluster]' ),
                 $cgi->end_form
         );
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3