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

View of /FigWebServices/extend_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (download) (annotate)
Mon Sep 4 20:09:55 2006 UTC (13 years, 5 months ago) by redwards
Branch: MAIN
CVS Tags: rast_rel_2008_06_18, rast_rel_2008_06_16, rast_rel_2008_07_21, rast_rel_2008_04_23, mgrast_rel_2008_0806, rast_rel_2008_08_07
Changes since 1.11: +1 -1 lines
using is_environmental

# -*- 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 Subsystem;

use HTML;
use strict;

use CGI;
my $cgi = new CGI;

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/extend_ssa_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/extend_ssa_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}
my($genome);

my $html = [];
my $subsys = $cgi->param('subsystem');
if (! $subsys)
{
    my @ssa = &existing_subsystem_annotations;

    if (@ssa > 0)
    {
	&format_ssa_table($cgi,$html,\@ssa);
    }
    else
    {
	push(@$html,$cgi->h1('Sorry, no subsystems defined'));
    }
}
elsif ($subsys && ($cgi->param('request') eq "extend_ssa"))
{
    &pick_a_genome($cgi,$fig,$html,$subsys);
}
elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "extend_ssa_with_genome"))
{
    $genome =~ s/:.*$//;
    &show_candidates($fig,$cgi,$html,$subsys,$genome);
}
elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "add_genome") && $cgi->param('Add Genome'))
{
    $genome =~ s/:.*$//;
    &make_assignments($cgi,$fig,$html);
    &add_a_genome($cgi,$fig,$html,$genome);
#    &pick_a_genome($cgi,$fig,$html,$subsys);
}
elsif ($subsys && ($genome = $cgi->param('genome')) && ($cgi->param('request') eq "add_genome") && $cgi->param('Just Make Assignments'))
{
    $genome =~ s/:.*$//;
    &make_assignments($cgi,$fig,$html);
    &pick_a_genome($cgi,$fig,$html,$subsys);
}
else
{
    push(@$html,$cgi->h1('invalid parameters'));
}

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

sub format_ssa_table {
    my($cgi,$html,$ssaP) = @_;

    push(@$html, $cgi->start_form(-action => "extend_subsys.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'request', -value => 'extend_ssa', -override => 1),
	         $cgi->scrolling_list( -name   => 'subsystem',
				       -values => [ map { $_->[0] } @$ssaP ],
				       -size   => 10
				       ),
	         $cgi->br,
	         $cgi->submit( 'Pick One' ),
	         $cgi->end_form
	 );
}

sub existing_subsystem_annotations {
    my($ssa,$name);
    my @ssa = ();
    if (opendir(SSA,"$FIG_Config::data/Subsystems"))
    {
	@ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
	closedir(SSA);
    }
    return sort { $a->[0] cmp $b->[0] } @ssa;
}

sub curator {
    my($ssa) = @_;
    my($who) = "";

    if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
    {
	$_  = <DATA>;
	if ($_ =~ /^\d+\t(\S+)\s+started/)
	{
	    $who = $1;
	}
	close(DATA);
    }
    return $who;
}

sub show_candidates {
    my($fig,$cgi,$html,$subsys,$genome_to_show) = @_;
    my($role,$known,@has,%has_filled,$x,$i,$tuple);

    my $sub           = $fig->get_subsystem($subsys);
    my @genomes       = $sub->get_genomes;
    my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
    my @roles         = $sub->get_roles;

    foreach $genome (@genomes)
    {

	next if (! &ok_variant($variant_codes{$genome}));
	@has = ();
	foreach $role (@roles)
	{
	    push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? 1 : 0);
	}
	push(@{$has_filled{join("",@has)}},$genome);
    }

    my @candidates = ();
    foreach $role (@roles)
    {
	$known = [];
	foreach $genome (@genomes)
	{
	    push(@$known,$sub->get_pegs_from_cell($genome,$role));
	}
	push(@candidates,[sort { $a->[2] <=> $b->[2] } $fig->best_bbh_candidates($genome_to_show,1.0e-20,10,$known)]);
    }

    @has = ();
    foreach $x (@candidates)
    {
	push(@has,(@$x > 0) ? 1 : 0);
    }

    my $best_so_far = 0;
    my $closest_variant;
    foreach $x (keys(%has_filled))
    {
	if (($_ = &matched($x,\@has)) && ($_ > $best_so_far))
	{
	    $best_so_far = $_;
	    $closest_variant = $x;
	}
    }

    if ($best_so_far)
    {
	$x = $has_filled{$closest_variant};
	my %variants;
	foreach $_ (@$x)
	{
	    $variants{$variant_codes{$_}}++;
	}
	my @ordered = sort { $variants{$b} <=> $variants{$a} } keys(%variants);
	my $gs = $fig->genus_species($x->[0]);
	push(@$html,$cgi->h1("It is possible that $genome: " . $fig->genus_species($genome) . " has an operational variant matching $gs"),
	            $cgi->start_form(-action => "extend_subsys.cgi",
				     -method => 'post'),
	            $cgi->hidden(-name => 'genome', -value => $genome, -override => 1),
	            $cgi->hidden(-name => 'variant', -value => $ordered[0], -override => 1),
	            $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
	            $cgi->hidden(-name => 'request', -value => 'add_genome', -override => 1)
	     );

	for ($i=0; ($i < @roles); $i++)
	{
	    $x = $candidates[$i];
	    if (@$x > 0)
	    {
		my $col_hdrs = ["Assign","Candidate","Length","Current Function","In Sub", "Score","Matched","Length","Function","UniProt Function"];
		my $tab = [];
		foreach $tuple (@$x)
		{
		    my($my_peg,$match_peg,$psc) = @$tuple;
		    my $my_peg_link = &HTML::fid_link($cgi, $my_peg, 1);
		    my $match_peg_link = &HTML::fid_link($cgi, $match_peg, 0);
		    my $checkbox = $cgi->checkbox(-name => "checked",
						  -value => "to=$my_peg,from=$match_peg",
						  -label => "");
		    my $my_len    = $fig->translation_length($my_peg);
		    my $match_len = $fig->translation_length($match_peg);
		    my $my_fn     = $fig->function_of($my_peg);
		    my $match_fn  = $fig->function_of($match_peg);
		    my @in_sub    = $fig->peg_to_subsystems($my_peg);
		    my $in_sub    = (@in_sub > 0) ? @in_sub : "&nbsp;";
		    my $uni = $fig->to_alias($my_peg,"uni");
		    my $uni_func = $uni ? $fig->function_of($uni) : "";
		    push(@$tab, [($my_fn eq $match_fn) ? "&nbsp;" : $checkbox,
				 $my_peg_link, $my_len, $my_fn,$in_sub,
				 $psc,
				 $match_peg_link, $match_len, $match_fn,$uni_func]);
		}

		push(@$html, &HTML::make_table($col_hdrs, $tab, "Candidates for $roles[$i]"),
		             $cgi->br,$cgi->br
		     );
	    }
	}
	push(@$html,$cgi->submit('Add Genome'), "&nbsp;&nbsp; ",
	            $cgi->submit('Just Make Assignments'),
	            $cgi->end_form
	     );
    }
    else
    {
	push(@$html,$cgi->h1('Probably does not have an operational variant'));
    }
}

sub known_hits {
    my($fig,$genome,$roles) = @_;
    my($role,$hits);

    $hits = 0;
    foreach $role (@$roles)
    {
	if ($fig->seqs_with_role($role,"master",$genome))
	{
	    $hits++;
	}
    }
    return $hits;
}

sub ok_variant {
    my($variant) = @_;

    return ($variant && ($variant ne "-1"));
}

sub matched {
    my($string,$v) = @_;
    my($n,$i);

    $n = 0;
    for ($i=0; ($i < @$v); $i++)
    {
	if (substr($string,$i,1) )
	{
	    if ($v->[$i])
	    {
		$n++;
	    }
	    else
	    {
		return 0;
	    }
	}
    }
    return $n;
}

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

    my($genome,%known_hits);

    my $sub = $fig->get_subsystem($subsys);
    my @roles   = $sub->get_roles;
    my %in = map { $_ => 1 } $sub->get_genomes;
    my @out = grep { ! $in{$_} } grep { !$fig->is_environmental($_) } $fig->genomes("complete");
    foreach $genome (@out)
    {
	$known_hits{$genome} = &known_hits($fig,$genome,\@roles);
    }
    @out = sort { ($known_hits{$b} <=> $known_hits{$a}) or ($a cmp $b) } @out;
    push(@$html, $cgi->start_form(-action => "extend_subsys.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
	         $cgi->hidden(-name => 'request', -value => 'extend_ssa_with_genome', -override => 1),
	         $cgi->scrolling_list( -name   => 'genome',
				       -values => [ map { $genome = $_; "$genome: " . $fig->genus_species($genome) } @out ],
				       -size   => 10
				       ),
	         $cgi->br,
	         $cgi->submit( 'Pick a Genome' ),
	         $cgi->end_form
	 );
}

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

    my $sub = $fig->get_subsystem($subsys);
    my @roles   = $sub->get_roles;
    my @genomes       = $sub->get_genomes;
    my $i;
    for ($i=0; ($i < @genomes) && ($genomes[$i] ne $genome); $i++) {}
    if ($i == @genomes)
    {
	$sub->add_genome($genome);
    }

    $sub->set_variant_code($sub->get_genome_index($genome),$cgi->param('variant'));

    my $role;
    foreach $role (@roles)
    {
	my @pegs = $fig->seqs_with_role($role,"master",$genome);
	if (@pegs > 0)
	{
	    $sub->set_pegs_in_cell($genome,$role,\@pegs);
	}
    }
    $sub->write_subsystem;
    push(@$html,$cgi->h1("Added $genome"));
}

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

    my $user      = $cgi->param('user');
    if (! $user) { $user = "master" }

    my $ent;
    my @checked = $cgi->param('checked');
    foreach $ent (@checked)
    {
	if ($ent =~ /^to=(.*),from=(.*)$/)
	{
	    my $to_peg = $1;
	    my $from_peg = $2;

	    my $from_func = $fig->function_of($from_peg);

	    next unless $from_func;

	    my $link = &HTML::fid_link($cgi, $to_peg, 0);
	    if ($user =~ /master:(.*)/)
	    {
		push(@$html, "Master assigning $from_func to $link<br>\n");
		my $userR = $1;
		$fig->assign_function($to_peg,"master",$from_func,"");
		$fig->add_annotation($to_peg,$userR,"Set master function to\n$from_func\n");
	    }
	    else
	    {
		push(@$html, "User $user assigning $from_func to $link<br>\n");
		$fig->assign_function($to_peg,$user,$from_func,"");
		$fig->add_annotation($to_peg,$user,"Set function to\n$from_func\n");
	    }
	}
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3