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

View of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (download) (annotate)
Mon Mar 12 13:39:05 2007 UTC (12 years, 11 months ago) by overbeek
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, 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, 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
Changes since 1.8: +1 -1 lines
fixes to allow non-peg features in subsystems

#
# 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 CGI;
my $cgi = new CGI;
use FIG_CGI;
use FigWebServices::SeedComponents;

my ($fig, $cgi, $user) = FIG_CGI::init(debug_save   => 0,
				       debug_load   => 0,
				       print_params => 0
				      );
my $html = [];
unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";
push(@$html,"<link type='text/css' rel='stylesheet' href='./Html/frame.css'>");

my $feature = $cgi->param('feature');
if (! $feature)
{
    unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
    push(@$html,"<h1>Sorry, you need to specify a feature</h1>\n");
    &HTML::show_page($cgi,$html);
    exit;
}

if ($feature !~ /^fig\|/)
{
    if ($_ = $fig->by_alias($feature))
    {
	$feature = $_;
    }
    else
    {
	unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
	push(@$html,"<h1>Sorry, $feature appears not to have a FIG id at this point</h1>\n");
	&HTML::show_page($cgi,$html);
	exit;
    }
}

my $request = $cgi->param("request") || "";

if    ($request eq "view_annotations")       { &view_annotations($fig,$cgi,$html,$feature); }
elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig,$cgi,$html,$feature); }
elsif ($request eq "dna_sequence")           { &dna_sequence($fig,$cgi,$html,$feature); }
else                                         { &show_initial($fig,$cgi,$html,$feature); }


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


#==============================================================================
#  view_annotations
#==============================================================================

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

    unshift @$html, "<TITLE>The SEED: eature Annotations</TITLE>\n";
    my $col_hdrs = ["who","when","annotation"];
    my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($feature) ];
    if (@$tab > 0)
    {
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $feature"));
    }
    else
    {
	push(@$html,"<h1>No Annotations for $feature</h1>\n");
    }
}

sub view_all_annotations {
    my($fig,$cgi,$html,$peg) = @_;
    my($ann);

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    if ($fig->is_real_feature($peg))
    {
	my $col_hdrs = ["who","when","PEG","genome","annotation"];
	my @related  = $fig->related_by_func_sim($peg,$cgi->param('user'));
	push(@related,$peg);

	my @annotations = $fig->merged_related_annotations(\@related);

	my $tab = [ map { $ann = $_;
			  [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
			   $fig->genus_species(&FIG::genome_of($ann->[0])),
			   "<pre>" . $ann->[3] . "</pre>"
			   ] } @annotations];
	if (@$tab > 0)
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
	}
	else
	{
	    push(@$html,"<h1>No Annotations for $peg</h1>\n");
	}
    }
}


#==============================================================================
#  show_initial
#==============================================================================

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

    unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
    my $gs = $fig->org_of($feature);

    if (! $fig->is_real_feature($feature))
    {
	push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
    }
    else
    {
	push(@$html,"<h1>Feature $feature: $gs</h1>\n");
	my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
	&display_fid($fig,$cgi,$html,$feature);
    }
}

#==============================================================================
#  display_fid
#==============================================================================

sub display_fid {
    my($fig,$cgi,$html,$fid) = @_;
    my $loc;

    
    my $graph = &FigWebServices::SeedComponents::Protein::get_peg_view({ fig_object => $fig,
									  peg_id     => $fid
									  }
									);
    push(@$html,$graph);
    
    my $contextH = &FigWebServices::SeedComponents::Protein::get_chromosome_context({ fig_object => $fig,
										       peg_id     => $fid
										       }
										     );

    push(@$html,$contextH->{table});

    push(@$html,$cgi->hr);
    my $link1 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_annotations";
    my $link2 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_all_annotations";
    push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");


    my $link = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=dna_sequence";
    push(@$html,"<br><a href=$link>DNA Sequence</a>\n");

    $link = $cgi->url(-relative => 1);
    $link =~ s/protein.cgi/fid_checked.cgi/;
    my $user = $cgi->param('user');
    if (! $user)
    {
	$user = "";
    }
    else
    {
	$link = $link . "?fid=$feature&user=$user&checked=$feature&assign/annotate=assign/annotate";
	push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
    }

    my $has_translation = $fig->translatable($fid);


}

sub dna_sequence {
    my($fig,$cgi,$html,$fid) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
    if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))
    {
	$func = $fig->function_of($feature,$cgi->param('user'));
	push(@$html,$cgi->pre,">$fid $func\n");
	for ($i=0; ($i < length($seq)); $i += 60)
	{
	    if ($i > (length($seq) - 60))
	    {
		push(@$html,substr($seq,$i) . "\n");
	    }
	    else
	    {
		push(@$html,substr($seq,$i,60) . "\n");
	    }
	}
	push(@$html,$cgi->end_pre);
    }
    else
    {
	push(@$html,$cgi->h1("No DNA sequence available for $fid"));
    }
}




sub in {
    my($x,$xL) = @_;
    my($i);

    for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
    return ($i < @$xL);
}

sub in_bounds {
    my($min,$max,$x) = @_;

    if     ($x < $min)     { return $min }
    elsif  ($x > $max)     { return $max }
    else                   { return $x   }
}

sub decr_coords {
    my($genes,$min) = @_;
    my($gene);

    foreach $gene (@$genes)
    {
	$gene->[0] -= $min;
	$gene->[1] -= $min;
    }
    return $genes;
}

sub flip_map {
    my($genes,$min,$max) = @_;
    my($gene);

    foreach $gene (@$genes)
    {
	($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
	$gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
    }
    return $genes;
}

sub cluster_genes {
    my($all_pegs,$peg) = @_;
    my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);

    my @color_sets = ();

    $conn = &get_connections_by_similarity($all_pegs);
    for ($i=0; ($i < @$all_pegs); $i++)
    {
	if ($all_pegs->[$i] eq $peg) { $pegI = $i }
	if (! $seen{$i})
	{
	    $cluster = [$i];
	    $seen{$i} = 1;
	    for ($j=0; ($j < @$cluster); $j++)
	    {
		$x = $conn->{$cluster->[$j]};
		foreach $k (@$x)
		{
		    if (! $seen{$k})
		    {
			push(@$cluster,$k);
			$seen{$k} = 1;
		    }
		}
	    }

	    if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
	    {
		push(@color_sets,$cluster);
	    }
	}
    }
    for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
    $red_set = $color_sets[$i];
    splice(@color_sets,$i,1);
    @color_sets = sort { @$b <=> @$a } @color_sets;
    unshift(@color_sets,$red_set);

    my $color_sets = {};
    for ($i=0; ($i < @color_sets); $i++)
    {
	foreach $x (@{$color_sets[$i]})
	{
	    $color_sets->{$all_pegs->[$x]} = $i;
	}
    }
    return $color_sets;
}

sub get_connections_by_similarity {
    my($all_pegs) = @_;
    my($i,$j,$tmp,$peg,%pos_of);
    my($sim,%conn,$x,$y);

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	$tmp = $fig->maps_to_id($all_pegs->[$i]);
	push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs
	if ($tmp ne $all_pegs->[$i])
	{
	    push(@{$pos_of{$all_pegs->[$i]}},$i);
	}
    }

    foreach $y (keys(%pos_of))
    {
	$x = $pos_of{$y};
	for ($i=0; ($i < @$x); $i++)
	{
	    for ($j=$i+1; ($j < @$x); $j++)
	    {
		push(@{$conn{$x->[$i]}},$x->[$j]);
		push(@{$conn{$x->[$j]}},$x->[$i]);
	    }
	}
    }

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	foreach $sim ($fig->sims($all_pegs->[$i],500,1.0e-5,"raw"))
	{
	    if (defined($x = $pos_of{$sim->id2}))
	    {
		foreach $y (@$x)
		{
		    push(@{$conn{$i}},$y);
		}
	    }
	}
    }
    return \%conn;
}

sub set_colors_text_and_links {
    my($gg,$all_pegs,$color_sets) = @_;
    my($map,$gene,$peg,$color);

    foreach $map (@$gg)
    {
	foreach $gene (@{$map->[3]})
	{
	    $peg = $gene->[5];
	    if (defined($color = $color_sets->{$peg}))
	    {
		$gene->[3] = ($color == 0) ? "red" : "color$color";
		$gene->[4] = $color + 1;
	    }
	    $gene->[5] = &peg_url($cgi,$peg);
	}
    }
}

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

    my $prot = $cgi->param('prot');
    $cgi->delete('prot');
    my $url  = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&prot=$peg&compare_region=1";
    $cgi->delete('prot');
    $cgi->param(-name => 'prot', -value => $prot);

    return $url;
}

sub trans_function_of {
    my($cgi,$fig,$peg,$user) = @_;

    if (wantarray())
    {
	my $x;
	my @funcs = $fig->function_of($peg);
	if ($cgi->param('translate'))
	{
	    @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;
	}
	return @funcs;
    }
    else
    {
	my $func = $fig->function_of($peg,$user);
	if ($cgi->param('translate'))
	{
	    $func = $fig->translate_function($func);
	}
	return $func;
    }
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3