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

View of /FigWebServices/extend_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (download) (annotate)
Sat Aug 23 23:39:22 2008 UTC (11 years, 2 months ago) by golsen
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, 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_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, HEAD
Changes since 1.12: +5 -14 lines
Move writing of assignment annotation from a case-by-case basis (and it
was missing in several key places) to the FIG::assign_function.

Modify the code in each of the calling locations to not make duplicate
annotations.

At the same time, remove (most) of the instances of making different
calls to assign_function depending on the user name.  assign_function
treats everyone as master (but writes an annotation with the real user
name).

# -*- perl -*-
#
# Copyright (c) 2003-2008 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);
	    push(@$html, "User $user assigning master function $from_func to $link<br>\n");
	    $fig->assign_function($to_peg,$user,$from_func,"");
	    #  Now in assign_function
	    # $fig->add_annotation($to_peg,$user,"Set function to\n$from_func\n");
	}
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3