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

View of /FigWebServices/pom.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (download) (annotate)
Fri Oct 5 18:33:12 2007 UTC (12 years, 1 month 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.21: +16 -4 lines
add check_variants.cgi, a program to automatically validate variant codes

#
# 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 strict;
use GenoGraphics;
use raelib; # this is used for the scrolling_org list
my $rae=raelib->new;

use CGI;
my $cgi = new CGI;
use CGI::Carp qw(fatalsToBrowser);

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/pom_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/pom_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}
my $html = ["<TITLE>The SEED Roles</TITLE>"];

my $role = $cgi->param('role');

my($request);
if     ($cgi->param('Occurrences') || $cgi->param('request') eq "Occurrences")                { $request = "show_occurrences"; $cgi->delete('Occurrences')     }
elsif  ($cgi->param('Occurrences by similarity'))  { $request = "show_occ_sim";     $cgi->delete('Occurrences by similarity') }
elsif  ($cgi->param('Clusters'))           { $request = "find_clusters";    $cgi->delete('Clusters')        }
elsif  ($cgi->param('FC'))                 { $request = "find_fc";          $cgi->delete('FC')              }
elsif  ($cgi->param('EC'))                 { $request = "ec_only"}
elsif  ($request = $cgi->param('request')) { $cgi->delete('request')                                        }
else                                       { $request = ""                                                  }

if ($request eq "show_occurrences")
{
    &show_occurrences($fig,$cgi,$html);
}
elsif ($request eq "show_occ_sim")
{
    &show_occ_sim($fig,$cgi,$html,$role);
}
elsif ($request eq "show_pegs")
{
    &show_pegs($fig,$cgi,$html,$role);
}
elsif ($request eq "find_in_org")
{
    &find_in_org($fig,$cgi,$html,$role);
}
elsif ($request eq "find_clusters")
{
    &find_clusters($fig,$cgi,$html);
}
elsif ($request eq "find_fc")
{
    &find_fc($fig,$cgi,$html,$role);
}
elsif ($request eq "ec_only")
{
    $role=[$cgi->param('EC')];
    &ec_only($fig,$cgi,$html,$role);
}
elsif ($request eq "full_fc_summary")
{
    &full_fc_summary($fig,$cgi,$html,$role);
}
elsif ($request eq "quick_fc_summary")
{
    &quick_fc_summary($fig,$cgi,$html,$role);
}
else
{
    &show_initial($fig,$cgi,$html,$role);
}

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

#
# Find the given role in the given (via CGI params) organism.
#
# We do this by finding a list of pegs that are annotated to have
# this role in other organisms that are "close enough" to our organism 
#
# We then find pegs in this organism that are similar to
# these pegs.
#
sub find_in_org {
    my($fig,$cgi,$html,$role) = @_;
    my($user,$id2,$psc,$col_hdrs,$tab,$peg,$curr_func,$id2_func);
    my($seen,$peg);

    ($user = $cgi->param('user')) || ($user = "");
    my $org = $cgi->param('org');
    my @allroles;
    if ($role eq "All Roles")  {@allroles=$cgi->param('allroles')} else {push @allroles, $role}

    if ($org)
    {
	#
	# Create a list of candidates.
	#
	# These are the list of sequences that contain the given role,
	# sorted by the crude_estimate_of_distance from the given peg.
	# 
        
        $tab=[];
        foreach my $r (@allroles) {
            my @cand = map { $_->[0] }
            sort { $a->[1] <=> $b->[1] }
            map { $peg = $_; [$peg,$fig->crude_estimate_of_distance($org,&FIG::genome_of($peg))] }
	    grep { $_ =~ /\.peg\./ }
            $fig->seqs_with_role($r,$user);

            my $hits = {};
            $seen = {};

#
# Pick the top 10 hits if there are more than 10.
#
            my $how_many = (@cand > 10) ? 10 : scalar @cand;

            &try_to_locate($fig,$org,$hits,[@cand[0..$how_many - 1]],$seen);

            if (keys(%$hits) == 0)
            {
                splice(@cand,0,$how_many);
                &try_to_locate($fig,$org,$hits,\@cand,$seen);
            }

#
# At this point %$hits contains the pegs in our organism that
# may have the given role. The key is the peg, the value
# is a pair [score, similar-peg]
#

            $col_hdrs = ["P-Sc","PEG","Ln1","Current Function", "Protein Hit","Ln2","Function"];
            foreach $peg ( sort {$hits->{$a}->[0] <=> $hits->{$b}->[0]} keys(%$hits))
            {
                ($psc,$id2) = @{$hits->{$peg}};
                $curr_func = $fig->function_of($peg,$user);
                $id2_func  = $fig->function_of($id2,$user);
                push(@$tab,[$psc,&HTML::fid_link($cgi,$peg,1),$fig->translation_length($peg),$curr_func,&HTML::fid_link($cgi,$id2),$fig->translation_length($id2),$id2_func]);
            }
        }
	if (@$tab > 0)
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"Possible PEGs"));
	}
	else
	{
	    push(@$html,$cgi->h1("Sorry, we could not locate any candidates for ".(join ", ", @allroles). " in $org "));
	}
    }
    else
    {
	push(@$html,$cgi->h1("Error: no organism specified"));
    }
}    

#
# Mark in $hits the pegs in $org that are similar to
# pegs in other organisms that have the given role.
# 
sub try_to_locate {
    my($fig,$org,$hits,$to_try,$seen) = @_;
    my($prot,$id2,$psc,$id2a,$x,$sim);

    my $cutoff = $cgi->param('sims_cutoff');
    if (! $cutoff) { $cutoff = 1.0e-5 }

    #
    # @$to_try is a list of pegs
    #
    foreach $prot (@$to_try)
    {
	#
	# If we've not looked at it before ...
	#
	if (! $seen->{$prot})
	{
	    if ($fig->genome_of($prot) eq $org)
	    {
		$hits->{$prot} = [0,$prot];
	    }
	    else
	    {
		#
		# Retrieve the top 1000 sims for this peg.  raw
		# means don't expand.
		#
		foreach $sim ($fig->sims($prot,1000,$cutoff,"raw",0))
		{
		    $id2 = $sim->id2;
		    $psc = $sim->psc;

		    #
		    # Retrieve the proteins that the sims map to.
		    #
		
		    foreach $id2a (map { $_->[0] } $fig->mapped_prot_ids($id2))
		    {
			#
			# If it's a protein in the organism we're looking in,
			# and if it's a better hit than the hit we had before,
			# mark it in $hits->{id} with the score and the
			# protein id.
			# 
			if (($id2a =~ /^fig\|(\d+\.\d+)/) && ($1 eq $org))
			{
			    $x = $hits->{$id2a};
			    if ((! $x) || ($x->[0] > $psc))
			    {
				$hits->{$id2a} = [$sim->psc,$prot];
			    }
			}
			#
			# Otherwise, mark it as having been seen if the score is good enough.
			#
			elsif ($psc < 1.0e-20)
			{
			    {
				$seen->{$id2a} = 1;
			    }
			}
		    }
		}
	    }
	}
    }
}

sub show_pegs {
    my($fig,$cgi,$html,$role) = @_;
    my($peg,@pegs,$user,$col_hdrs,$tab);

    @pegs = $cgi->param('peg');
    ($user = $cgi->param('user')) || ($user = "");
    if (@pegs > 0)
    {
	$col_hdrs = ["PEG","Function"];
	$tab = [];
	foreach $peg (@pegs)
	{
	    my $func = $fig->function_of($peg,$user);
	    my $link = &HTML::fid_link($cgi,$peg);
	    push(@$tab,[$link,$func]);
	}
	my $role_ext = &HTML::ec_link($fig->expand_ec($role));
	my $gs = $fig->org_of($pegs[0]);
	push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs possibly implementing $role_ext in $gs"));
    }
}

sub old_show_occ_sim {
    my($fig,$cgi,$html) = @_;
    my($neigh,@roles);

    my @orgs = $cgi->param('korgs');
    @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;

    if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) > 0)
    {
	&show_occ_by_sims($fig,$cgi,$html,$orgs[0],\@roles);
    }
    else
    {
	push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
    }
}

sub show_occ_sim {
    my($fig,$cgi,$html) = @_;
    my(@neigh,@roles);

    if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) == 0)
    {
        @roles = $cgi->param('role');
    }
    

    @roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } @roles;

    my @orgs=$cgi->param('korgs');
    if (scalar(@orgs) != 1)
    {
        push(@$html,$cgi->h1("Please choose just a single organism from the list so we can look through its sims"));
        return;
    }
    
    if (@roles > 0)
    {
        my @genomes=$fig->genomes("complete");
        my $ss = &make_ss(\@genomes,\@roles,$orgs[0]);
        &show_occ_body_like_ss($fig,$cgi,$html,\@roles,$ss,\@genomes);
    }
    else
    {
        push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
    }
}


sub show_occurrences {
    my($fig,$cgi,$html) = @_;
    my(@neigh,@roles);

    if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) == 0)
    {
        @roles = $cgi->param('role');
    }

    #push @$html, $cgi->div({class=>"diagnostic"}, $cgi->p("Neighborhood: ", join ("<br />", @neigh)), $cgi->p("ROLES: ", @roles));
    @roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } @roles;
    if (@roles > 0)
    {
        &show_occ_by_assignments($fig,$cgi,$html,\@roles);
    }
    else
    {
        push(@$html,$cgi->h1("You need to fill in a set of roles making up the POM"));
    }
}


sub show_occ_by_assignments {
    my($fig,$cgi,$html,$roles) = @_;
    my $user;

    ($user = $cgi->param('user')) || ($user = "");
    my @genomes;
    ($cgi->param('korgs')) ? (@genomes=$cgi->param('korgs')) : (@genomes=$fig->genomes("complete"));
#push @$html, $cgi->div({class=>"diagnostic"}, $cgi->p("KORGS: |", $cgi->param('korgs'), "|"), $cgi->p("GENOMES: |",join("|", @genomes),"|"));
    my $ss = $fig->seqs_with_roles_in_genomes(\@genomes,$roles,$user);
    &show_occ_body_like_ss($fig,$cgi,$html,$roles,$ss,\@genomes);
}

sub make_ss {
    my($orgs,$roles,$org) = @_;
    my($role,$peg,$id2,$sim);
    my $ss = {};

    my %orgs = map { $_ => 1 } @$orgs;
    my($roles1,$roles2);
    $roles1 = [];
    $roles2 = [];
    foreach $role (@$roles)
    {
	if ($role =~ /^fig/)
	{
	    push(@$roles2,$role);
	}
	else
	{
	    push(@$roles1,$role);
	}
    }
    
    if (@$roles1 > 0)
    {
	my $ss1 = $fig->seqs_with_roles_in_genomes([$org],$roles1);
	foreach $role (keys(%{$ss1->{$org}}))
	{
	    foreach $peg (map { $_->[0] } @{$ss1->{$org}->{$role}})
	    {
		foreach $sim ($fig->sims($peg,500,1.0e-10,"fig"))
		{
		    $id2 = $sim->id2;
		    if ($id2 =~ /^fig\|(\d+\.\d+)/)
		    {
			$ss->{$1}->{$role}->{$id2} = 1;
		    }
		}
	    }
	}
    }

    foreach $peg (@$roles2)
    {
	foreach $sim ($fig->sims($peg,500,1.0e-10,"figx"))
	{
	    $id2 = $sim->id2;
	    if ($id2 =~ /^fig\|(\d+\.\d+)/)
	    {
      	        $ss->{$1}->{$peg}->{$id2} = 1;
	    }
	}
    }

    my $org;
    foreach $org (keys(%$ss))
    {
	my $sub1 = $ss->{$org};
	foreach $role (keys(%$sub1))
	{
	    my $sub2 = $sub1->{$role};
	    $sub1->{$role} = [map { [$_,""] } sort { &FIG::by_fig_id($a,$b) } keys(%$sub2)];
	}
    }
    return $ss;
}

sub ec_only {
    my($fig,$cgi,$html,$roles) = @_;
    my $col_hdrs = ["Column","Functional Role", "Subsystems", "KEGG"];
    my $tab      = [];


    foreach my $r (@$roles)
    {
        my $ssinfo;
        foreach my $ssi ($fig->subsystems_for_ec($r))
        {
            $ssinfo->{$ssi->[0]}->{$ssi->[1]}++;
        }

        foreach my $subsys (sort {$a cmp $b} keys %$ssinfo)
        {
            foreach my $ssrole (sort {$ssinfo->{$b} <=> $ssinfo->{$a} || $a cmp $b} keys %{$ssinfo->{$subsys}})
            {
                push @$tab, [$fig->expand_ec($r), $ssrole, &HTML::sub_link($cgi, $subsys), &HTML::ec_link($r)];
            }
        }
    }
    


    push(@$html, 
        $cgi->start_form(-action=>"pom.cgi", -method=>"get"),
        $cgi->div({class=>"bluefloat"}, "This table shows the role(s) that you have chosen, their functions, a link to the subsystem(s) they are in, and a link to the KEGG site in Japan"),
        &HTML::make_table(["Function", "Functional Role<br>In Subsystem", "Subsystem", "KEGG"], $tab,"Functional Roles")
        );
}                                                                                        


sub show_occ_body_like_ss {
# RAE:
# Added this method that makes the display look like the display from subsys.cgi and gives us a more uniform feel to everything. Also rearranged slightly

    my($fig,$cgi,$html,$roles,$ss,$genomes) = @_;
    my($x,$i,%pos,$user,$genome,$row);
    #$push @$html,  $cgi->div({class=>"diagnostic"}, $cgi->p("ROLE: $role"));
    push @$html, $cgi->h1("POM in the neighborhood of ", &HTML::ec_link($fig->expand_ec($role)), "\n");

    # generate the functions and figure out what is here
    # note that tab1 is generated below so we can include sslinks
    my $function;
    for ($i=0; ($i < @$roles); $i++)
    {
	$pos{$roles->[$i]} = $i+1;
	if ($roles->[$i] !~ /^fig/)
	{
            $function->{$i}=$fig->expand_ec($roles->[$i]);
	}
	else
	{
            $function->{$i}=scalar($fig->function_of($roles->[$i]));
	}
    }
    
    my $col_hdrs2 = ["Genome<br />ID", "Organism"];
    push @$col_hdrs2, map {"<a " . FIGjs::mouseover("Functional Role", $function->{$_}) . ">".($_+1)."</a>"} (0..$#$roles);
    my $inter_headers; # these are the headeers that will be interspersed in the table
    @$inter_headers=map {$_=[$_, "th"]} @$col_hdrs2; # convert those to <th> </th> elements using arrays and the "coloring" code
    
    my $tab2 = [];
    
    #foreach $genome ($fig->sort_genomes_by_taxonomy(keys(%$ss)))
    my $subsystems;
    foreach $genome (sort {$fig->genus_species($a) cmp $fig->genus_species($b)} @$genomes)
    {
	$cgi->delete($role);
	$cgi->delete('neighborhood');
	$cgi->delete('request');
	$cgi->delete('peg');
	$cgi->delete('org');
        $cgi->delete('korgs');
	
	$row = [$genome, $fig->genus_species($genome)];
	for ($i=0;($i < @$roles); $i++)
	{
	    $cgi->param(-name => "role",
			-value => $roles->[$i]);
	    
	    $x = $ss->{$genome}->{$roles->[$i]};

            my @links;
            if (defined($x))
            {
                foreach my $peg (map {$_->[0]} @$x)
                {
                    my @subsyslist=$fig->peg_to_subsystems($peg);
                    map {$subsystems->{$roles->[$i]}->{$_}=1} @subsyslist;
                    #if ($cgi->param('show') eq "all" || (scalar(@subsyslist)))
                    if (scalar(@subsyslist))
                    {
                        my $link = ( $cgi->param('ext_ids') ? external_id($fig,$cgi,$peg)  : HTML::fid_link($cgi,$peg, "local") );
                        # horrible, horrible botch. Please ignore this
                        my $mo=FIGjs::mouseover("Subsystems", (join("<br />", @subsyslist)));
                        $link =~ s/<a\s+/<a $mo /;
                        push @links, "<span style=\"background-color: #FF0\">$link</span>";
                    }
                    #elsif ($cgi->param('show') eq "all")
                    else
                    {
                        my $link = ( $cgi->param('ext_ids') ? external_id($fig,$cgi,$peg)  : HTML::fid_link($cgi,$peg, "local") );
                        push @links, $link;
                    }
                }
            }
	    #else
	    #{
	#	$cgi->param(-name => "request",
	#		    -value => "find_in_org");
	#	$cgi->param(-name => "org",
	#		     -value => "$genome");
	#	my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
	#	push @links, "<a href=$url>0</a>";
	 #   }
            unless (@links) {@links=" &nbsp; "}
	    push(@$row,join (", <br />", @links));
	}
	push(@$tab2,$row);
        unless (scalar(@$tab2) % 10) {push @$tab2, $inter_headers}
    }
    
    my $col_hdrs1 = ["Column","Functional Role", "Subsystems", "KEGG"];
    my $tab1      = [];
    for ($i=0; ($i < @$roles); $i++)
    {
	my $sslinks=join("; <br />", map {&HTML::sub_link($cgi, $_)} keys %{$subsystems->{$roles->[$i]}});
        if ($roles->[$i] !~ /^fig/)
	{
	    push(@$tab1,[$i+1,$function->{$i}, $sslinks, &HTML::ec_link($roles->[$i])]);
	}
	else
	{
	    push(@$tab1,[$i+1,$function->{$i}, $sslinks, &HTML::fid_link($cgi,$roles->[$i])]);
	}
    }
    
    my $glabels={map {($_=>$fig->genus_species($_))} @$genomes};
    my $rlabels={map {($roles->[$_]=>$function->{$_})} 0..$#$roles};
    push(@$html, 
        $cgi->start_form(-action=>"pom.cgi", -method=>"get"),
        $cgi->div({class=>"bluefloat"}, "This table shows the role(s) that you have selected, their functions, a link to the subsystem(s) they are in, and a link to the KEGG site in Japan"),
        &HTML::make_table($col_hdrs1,$tab1,"Functional Roles"),$cgi->hr,
        $cgi->div({class=>"bluefloat"}, $cgi->p("This table shows which proteins in these genomes have this role, and if you mouse over each protein it will show you which subsystems that protein is in. Only cells with yellow backgrounds are in subsystems, others are not."), $cgi->p("The columns are the same as the roles listed in the table above. If you mouse over the column headers (or their repetitions throughout) you will get the functional roles shown")),
        &HTML::make_table($col_hdrs2,$tab2,"Occurrences of Roles in POM"), $cgi->p,
        $cgi->p("To get suggestions for proteins that are missing from this table, choose a genome and role from these menus:"),
        $cgi->hidden(-name=>"request", -value=>"find_in_org"), $cgi->hidden(-name=>"allroles", -value=>[keys %$rlabels]),
        $cgi->popup_menu(-name=>"org", -values=>[sort {$glabels->{$a} cmp $glabels->{$b}} keys %$glabels], -labels=>$glabels), $cgi->br,
        $cgi->popup_menu(-name=>"role", -values=>["All Roles", sort {$rlabels->{$a} cmp $rlabels->{$b}} keys %$rlabels], -labels=>$rlabels, -default=>"All Roles"),
        $cgi->br, $cgi->submit, $cgi->reset, $cgi->end_form,
    );
}

sub show_occ_body {
    my($fig,$cgi,$html,$roles,$ss,$genomes) = @_;
    my($x,$col_hdrs,$tab,$i,%pos,$user,$genome,$row);

    $col_hdrs = ["Column","Functional Role"];
    $tab      = [];
    for (my $i=0; ($i < @$roles); $i++)
    {
	$pos{$roles->[$i]} = $i+1;
	if ($roles->[$i] !~ /^fig/)
	{
	    push(@$tab,[$i+1,&HTML::ec_link($fig->expand_ec($roles->[$i]))]);
	}
	else
	{
	    push(@$tab,[$i+1,&HTML::fid_link($cgi,$roles->[$i])]);
	}
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Roles in POM"),$cgi->hr);
    
    $col_hdrs = ["Genome",1..@$roles];
    $tab = [];
    
    #foreach $genome ($fig->sort_genomes_by_taxonomy(keys(%$ss)))
    foreach $genome (sort {$fig->genus_species($a) cmp $fig->genus_species($b)} @$genomes)
    {
	$cgi->delete($role);
	$cgi->delete('neighborhood');
	$cgi->delete('request');
	$cgi->delete('peg');
	$cgi->delete('org');
        $cgi->delete('korgs');
	
	$row = [ $fig->genus_species($genome)];
	for ($i=0;($i < @$roles); $i++)
	{
	    my($link,$n,$pegs,$url);
	    $cgi->param(-name => "role",
			-value => $roles->[$i]);
	    
	    $x = $ss->{$genome}->{$roles->[$i]};
	    if (defined($x) && (@$x > 1))
	    {
		$cgi->param(-name => "peg",
			    -value => [map { $_->[0] } @$x]);
		$cgi->param(-name => "request",
			    -value => "show_pegs");
		
		$url = $cgi->url(-relative => 1, -query => 1, -path_info => 1); 
		$n = scalar @$x;
		$link = "<a href=$url>$n</a>";
	    }
	    elsif (defined($x) && (@$x == 1))
	    {
		$url = $cgi->url(-relative => 1) . "?prot=$x->[0]->[0]&user=$user";
		$url =~ s/pom.cgi/protein.cgi/;
		$link = "<a href=$url>1</a>";
	    }
	    else
	    {
		$cgi->param(-name => "request",
			    -value => "find_in_org");
		$cgi->param(-name => "org",
			     -value => "$genome");
		$url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
		$link = "<a href=$url>0</a>";
	    }
	    push(@$row,$link);
	}
	push(@$tab,$row);
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Occurrences of Roles in POM"));
}

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

    my($roles_in_textarea,@neigh);
    if ((! $role) && ($roles_in_textarea = $cgi->param('roles_in_textarea')))
    {
	$roles_in_textarea =~ tr/\r/\n/;
	@neigh = grep { $_ } split(/\n/,$roles_in_textarea);
    }

    if ((! $role) && (! @neigh))
    {
        my @roles=$fig->all_roles();
        my %rr=map {$_->[0]=>$_->[0]." - ". $_->[1]} @roles;
        push @$html, $cgi->start_form, $cgi->h1("POM - Pieces of Metabolism"),
            $cgi->p("Please choose a role. Pick ECs, or carefully paste a set into the textarea"),
            $cgi->scrolling_list(-name=>"role", -values=>[sort {$a cmp $b} keys %rr], -labels=>\%rr, -multiple=>1, -size=>10),
	    $cgi->br,
            $cgi->textarea( -name => 'roles_in_textarea', -rows => 6, columns => 100),
            $cgi->p(),
            $cgi->submit, $cgi->reset, $cgi->end_form;
	return;
    }
    
    my $user = $cgi->param('user');
    push(@$html,$cgi->start_form(-action => "pom.cgi", -name=> "pom", -method=>"GET"));
    if ($user)
    {
	push(@$html,$cgi->hidden(-name => "user", -value => $user));
    }

    if (! @neigh)
    {    
	@neigh = map { $fig->expand_ec($_) } ($fig->neighborhood_of_role($role));
    }
    #my $rows = @neigh + 5;
    
   #                                     -values         => \@neigh,
   #                                     -default        => \@neigh,

    my($org,$gs);
    push(@$html, 
                $cgi->h1("These are the roles in the neighborhood of ", &HTML::ec_link($fig->expand_ec($role)), "\n"), 
                $cgi->div({class=>"bluefloat"},
                $cgi->p("Please select one or more of these roles to explore the presence in different genomes.",
                " You can select the genomes in the menu below."),
                ),
                
                $cgi->checkbox_group(  -name           => 'neighborhood',
                                       -values         => \@neigh,
                                       -default        => \@neigh,
                                       -columns        => 2,
                                    ),
                $cgi->p({style=>"margin-bottom: 3em"},&HTML::java_buttons("pom", "neighborhood")),
                
                $cgi->div({class=>"bluefloat"},
                $cgi->p("To explore these roles, you can either look for occurences in all the genomes by not selecting anything, ", 
                " or you can select one or more genomes from this list to narrow your search.")),
                $rae->scrolling_org_list($cgi, 1),
                $cgi->br,
	 );

#    push(@$html,$cgi->textarea( -name   => 'neighborhood',
#                                -value  => join("\n",@neigh),
#				-rows   => $rows,
#				-cols   => 70
#			      ),
    push(@$html,"Similarity Threshhold: ",
	        $cgi->textfield(-name => "sims_cutoff", -value => 1.0e-10,-size => 8), $cgi->br,
	        $cgi->hidden(-name => 'role', -value => $role),
	        $cgi->submit('Occurrences'),
	        $cgi->submit('Occurrences by similarity'),
	        $cgi->submit('Clusters'),
	        $cgi->submit('FC'),
	        $cgi->end_form
	 );
}

sub find_clusters {
    my($fig,$cgi,$html) = @_;
    my($neigh,@roles,$user,$ss,$org,@pegs,$x,$y,$role,$peg,$loc,$contig,$beg,$end);
    my($i,$j,$col_hdrs,$tab,@clusters,$cluster,$gs);

    if ((@roles = map { $_ =~ s/^(\d+\.\d+\.\d+\.\d+)\s+-\s+.*$/$1/; $_ } $cgi->param('neighborhood')) > 0)
    {
	($user = $cgi->param('user')) || ($user = "");
	@clusters = $fig->largest_clusters(\@roles,$user,1);

	$col_hdrs = ["PEG","function"];
	foreach $cluster (@clusters)
	{
	    $tab = [];
	    $gs = $fig->org_of($cluster->[0]);

	    foreach $peg (@$cluster)
	    {
		push(@$tab,[&HTML::fid_link($cgi,$peg,1),scalar $fig->function_of($peg,$user)]);
	    }
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"Cluster in $gs"),$cgi->hr);
	}
    }
}

sub find_fc {
    my($fig,$cgi,$html,$role) = @_;
    my($peg_index_data,$peg,$n,@poss,$col_hdrs,$tab);

    ($peg_index_data,undef) = $fig->search_index($role);
    foreach $peg (map { $_->[0] } @$peg_index_data)
    {
	my @tmp = $fig->in_cluster_with($peg);
	$n = @tmp;
	if ($n > 0)
	{
	    push(@poss,[$n,$peg]);
	}
    }
    @poss = sort { $b->[0] <=> $a->[0] } @poss;
    $col_hdrs = ["Size Cluster","PEG","Function"];
    $tab      = [map { ($n,$peg) = @$_; [$n,&HTML::fid_link($cgi,$peg),scalar $fig->function_of($peg,$cgi->param('user'))] } @poss];
    push(@$html,&HTML::make_table($col_hdrs,$tab,"PEGs that show Functional Coupling"));
    $cgi->delete('neighborhood');

    my $min = int((@poss * 0.8) / 60);
    $cgi->delete('request');
    $cgi->param(-name => "request", -value => "quick_fc_summary");
    my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
    push(@$html,$cgi->br,
	        "<a href=$url>Quick FC Summary [estimated time = $min minutes]</a>");

    $min = int((@poss * 15) / 60);
    $cgi->param(-name => "request", -value => "full_fc_summary");
    my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
    push(@$html,$cgi->br,
	        "<a href=$url>Full FC Summary [estimated time = $min minutes]</a>");
}

sub full_fc_summary {
    my($fig,$cgi,$html,$role) = @_;
    my($peg_index_data,$peg,$peg1,@coupling_data,$coupled,$score,$func,$func1);
    my(@hypos,%non_hypos);

    my $expanded = $fig->expand_ec($role);
    ($peg_index_data,undef) = $fig->search_index($role);
    foreach $peg (map { $_->[0] } @$peg_index_data)
    {
	$func = $fig->function_of($peg,$cgi->param('user'));
	@coupling_data = $fig->coupling_and_evidence($peg,5000,1.0e-10,0.1,"keep");
	foreach $coupled (@coupling_data)
	{
	    ($score,$peg1) = @$coupled;
	    $func1 = $fig->function_of($peg1,$cgi->param('user'));
	    if (&FIG::hypo($func1))
	    {
		push(@hypos,[$func1,$score,$peg,$peg1]);
	    }
	    else
	    {
		if ((! $non_hypos{$func1}) || ($non_hypos{$func1}->[0] < $score))
		{
		    $non_hypos{$func1} = [$score,$peg,$peg1];
		}
	    }
	}
    }
    &tabulate_results($fig,$cgi,$html,$role,\%non_hypos,\@hypos);
}

sub tabulate_results {
    my($fig,$cgi,$html,$role,$non_hypos,$hypos) = @_;
    my($entry,$func1,$score,$peg,$peg1,$func);
    my(@hypos,%non_hypos,$func,@poss);

    my $expanded = $fig->expand_ec($role);
    my @poss = sort { $b->[1] <=> $a->[1] } map { [$_,@{$non_hypos->{$_}}] } keys(%$non_hypos);
    my $col_hdrs = ["Coupling Score","PEG1","Function1","PEG2","Function2"];
    my $tab = [];
    foreach $entry (@poss)
    {
	($func1,$score,$peg,$peg1) = @$entry;
	$func = $fig->function_of($peg,$cgi->param('user'));
	push(@$tab,[$score,
		    &HTML::fid_link($cgi,$peg),$func,
		    &HTML::fid_link($cgi,$peg1),$func1]);
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Functions Coupled to $expanded"));
    push(@$html,$cgi->hr);

    $tab = [];
    @poss = sort { $b->[1] <=> $a->[1] } @$hypos;
    $tab = [];
    foreach $entry (@poss)
    {
	($func1,$score,$peg,$peg1) = @$entry;
	$func = $fig->function_of($peg,$cgi->param('user'));
	push(@$tab,[$score,
		    &HTML::fid_link($cgi,$peg),$func,
		    &HTML::fid_link($cgi,$peg1),$func1]);
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Hypothetical Proteins Coupled to $expanded"));
}

sub quick_fc_summary {
    my($fig,$cgi,$html,$role) = @_;
    my($peg_index_data,$peg,$peg1,%relevant,%close_enough,$func1,@pinned);
    my(%non_hypos,@hypos,$sc,%seen);

    ($peg_index_data,undef) = $fig->search_index($role);
    my @all_pegs = map { $_->[0] } @$peg_index_data;

    foreach $peg (@all_pegs)
    {
	my @close = $fig->close_genes($peg,5000);
	foreach $peg1 (@close)
	{
	    $close_enough{$peg1} = 1;
	}
    }

    foreach $peg (@all_pegs)
    {
	foreach $peg1 (grep { $close_enough{$_} } $fig->in_cluster_with($peg))
	{
	    if ($peg1 ne $peg)
	    {
		$relevant{$peg1} = $peg;
	    }
	}
    }

    foreach $peg (keys(%relevant))
    {
	if (! $seen{$peg})
	{
	    $seen{$peg} = 1;
	    @pinned = grep { $relevant{$_} && (! $seen{$_}) } $fig->in_pch_pin_with($peg);
	    if (@pinned > 1)
	    {
		$sc = $fig->score(\@pinned);
		foreach $peg1 (@pinned)
		{
		    $seen{$peg1} = 1;
		    $func1 = $fig->function_of($peg1,$cgi->param('user'));
		    if (&FIG::hypo($func1))
		    {
			push(@hypos,[$func1,$sc,$relevant{$peg1},$peg1]);
		    }
		    else
		    {
			if ((! $non_hypos{$func1}) || ($non_hypos{$func1}->[0] < $sc))
			{
			    $non_hypos{$func1} = [$sc,$relevant{$peg1},$peg1];
			}
		    }
		}
	    }
	}
    }
    &tabulate_results($fig,$cgi,$html,$role,\%non_hypos,\@hypos);
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3