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

View of /FigWebServices/assign_using_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.17 - (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.16: +5 -12 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 gjoseqlib;
use gjonewicklib;

use FIG;
my $fig = new FIG;

use HTML;
use strict;
use tree_utilities;

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

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/align_using_tree_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";
    }
    exit;
}

if (0)
{
    print STDERR $cgi->header;
    my @params = $cgi->param;
    print STDERR "<pre>\n";
    foreach $_ (@params)
    {
	print STDERR "$_\t:",join(",",$cgi->param($_)),":\n";
    }
    #exit;
}
if (1)
{
	if (open(TMP,">/tmp/align_using_tree_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
}

my $html = [];
my $user      = $cgi->param('user');
my $ali_dir   = $cgi->param('ali_dir');
my $ali_num   = $cgi->param('ali_num');
my $request   = $cgi->param('request');
my $full_path = $cgi->param('full_path');
my $dump_xml = $cgi->param('xml');

my($node,$nodeP,$tips,@kept,%kept,$subtree,$index,@checked,@checkedN,@checkedL);
my($func,$userR,$peg);

if (! $user)
{
    push(@$html,$cgi->h1('You need to specify a user to assign via a tree'));
}
elsif ((! $ali_dir) && (! $full_path))
{
    push(@$html,$cgi->h1('You need to specify an alignment directory to assign via a tree'));
}
elsif ((! $full_path) && ((! $ali_num) || ($ali_num !~ /^\d+\.\d+/)))
{
    push(@$html,$cgi->h1('You need to specify a valid alignment number in order to assign via a tree'));
}
else
{
    if (! $full_path)
    {
	$ali_num =~ /^(\d+)\.(\d+)/;
	my $ali_numIa = $1;
	my $ali_numIb = $2;
	$full_path = "$ali_dir/$ali_numIa/$ali_numIb";
    }
    
    my $tree;
    if ((-s "$full_path/tree.dnd") &&
	($tree  = &parse_newick_tree(join("",`cat \"$full_path/tree.dnd\"`))))
    {
	my $to_peg = {};
	my $to_id = {};
	if (open(INDEX,"<$full_path/ids"))
	{
	    while (defined($_ = <INDEX>))
	    {
		if ($_ =~ /^(\S+)\t(fig\|\d+\.\d+\.peg\.\d+)/)
		{
		    $to_peg->{$1} = $2;
		    $to_id->{$2} = $1;
		}
	    }
	    close(INDEX);
	    my $tips = &tree_utilities::tips_of_tree($tree);
            my @ok = grep { $fig->is_real_feature($to_peg->{$_}) } @$tips;
            if (@ok != @$tips)
            {
                my %keep = map { $_ => 1 } @ok;
                $tree = &tree_utilities::subtree($tree,\%keep);
            }
	}
	&label_all_nodes($tree);

	if ($cgi->param('Reroot tree'))
	{
	    my @checked    = ($cgi->param('checked_leaf'),$cgi->param('checked_nonleaf'));
	    if (@checked == 1)
	    {
		&process_reroot($fig,$cgi,$html,$user,$tree,$checked[0],$to_id,$to_peg);
	    }
	    else
	    {
		push(@$html,$cgi->h1('you need to check a single node or leaf on a reroot'));
	    }
	}
	elsif ($cgi->param('Zoom to Subtree'))
	{
	    my @checked    = $cgi->param('checked_nonleaf');
	    if (@checked == 1)
	    {
		&process_zoom($fig,$cgi,$html,$user,$tree,$checked[0],$to_id,$to_peg);
	    }
	    else
	    {
		push(@$html,$cgi->h1('you need to check a single internal node for a zoom'));
	    }

	}
	elsif ($cgi->param('UnZoom'))
	{
	    &display_initial_tree($fig,$cgi,$html,$user,$tree,$to_peg);
	}
	elsif ($cgi->param('Reset tree') && $full_path && ($full_path =~ /\/(\d+\.\d+\.peg\.\d+)\/PHOB$/))
	{
	    my $id = $1;
	    system "/bin/rm -r $full_path";
	    my $ali_tree = new AliTree($id,$fig);
	    $full_path = $ali_tree->phob_dir;
	    if ((-s "$full_path/tree.dnd") &&
		($tree  = &parse_newick_tree(join("",`cat \"$full_path/tree.dnd\"`))))
	    {
		my $to_peg = {};
		my $to_id = {};
		if (open(INDEX,"<$full_path/ids"))
		{
		    while (defined($_ = <INDEX>))
		    {
			if ($_ =~ /^(\S+)\t(fig\|\d+\.\d+\.peg\.\d+)/)
			{
			    $to_peg->{$1} = $2;
			    $to_id->{$2} = $1;
			}
		    }
		    close(INDEX);
		}
		&label_all_nodes($tree);
		&display_initial_tree($fig,$cgi,$html,$user,$tree,$to_peg);
	    }
	    else
	    {
		push(@$html,$cgi->h1("Reset failure: Please save the URL and send it to Ross"));
	    }
	}
	elsif ($cgi->param('Show Alignment'))
	{
	    @checked    = $cgi->param('checked_nonleaf');
	    if (@checked <= 1)
	    {
		if (@checked == 0) { @checked = ($tree->[0]) }
		my $index = &tree_index_tables($tree);
		if (my $subtree = &tree_utilities::locate_node(\@checked,$index))
		{
		    my %tips = map { $_ => 1 } @{&tree_utilities::tips_of_tree($subtree)};
		    my $labels = {};
		    foreach my $id (keys(%tips))
		    {
			my $peg = $to_peg->{$id};
			my $func = $fig->function_of($peg);
			my $gs   = $fig->genus_species(&FIG::genome_of($peg));
			my $url  = &HTML::fid_link($cgi,$peg,0,1);
			my $link = "<a href=$url>$peg: $gs     $func</a>";
			$labels->{$id} = $link;
		    }
		    my @ali  = map { $_->[0] = ($to_peg->{$_->[0]}) ? $to_peg->{$_->[0]} : $_->[0]; $_ }
		               grep { $tips{$_->[0]} }
   			       &gjoseqlib::read_fasta("$full_path/aln.fasta");
		    my @ali  = &gjoseqlib::pack_alignment(\@ali);
		    my $cache = "fid_checked_data_${$}_" . sprintf( '%09d', 1e9*rand()+0.5 );
		    &write_cached_align($cache,\@ali);
		    &tree_utilities::relabel_nodes($subtree,$labels);
		    &write_cached_tree($cache,$subtree);
		    $ENV{'REQUEST_METHOD'} = 'GET';
		    $ENV{'QUERY_STRING'} = "user=$user&cached=$cache&update=update";
		    my @fid_checked = `./fid_checked.cgi`;
		    while ((@fid_checked > 0) && ($fid_checked[0] !~ /Alignment of Selected Proteins/))
		    {
			shift @fid_checked;
		    }
		    push(@$html,@fid_checked);
		}
	    }
	}
	elsif ($cgi->param('Delete subtrees'))
	{
	    @checked    = ($cgi->param('checked_leaf'),$cgi->param('checked_nonleaf'));
	    if (@checked > 0)
	    {
		$index = &tree_index_tables($tree);
		my %deleted_nodes;
		foreach $node (@checked)
		{
		    $node = $to_id->{$node} ? $to_id->{$node} : $node;
		    if ($node =~ /^id\d+/)
		    {
			$deleted_nodes{$node} = 1;
		    }
		    else
		    {
			$nodeP = &label_to_node($index,$node);
			$tips  = &tips_of_tree($nodeP);
			foreach $_ (@$tips)
			{
			    $deleted_nodes{$_} = 1;
			}
		    }
		}
		@kept = grep { ! $deleted_nodes{$_} } @{ &tips_of_tree($tree) };
		%kept = map { $_ => 1 } @kept;
		$subtree = &subtree($tree,\%kept);
		rename("$full_path/tree.dnd","$full_path/tree.dnd~");
		&write_newick($subtree,"$full_path/tree.dnd");
		&display_initial_tree($fig,$cgi,$html,$user,$subtree,$to_peg);
	    }
	}
	elsif ($cgi->param('make_assignment'))
	{
	    $index = &tree_index_tables($tree);
	    @checkedN    = $cgi->param('checked_nonleaf');
	    @checkedL    = $cgi->param('checked_leaf');
	    if ((@checkedN == 1) && 
		(@checkedL == 1) && 
		(! $cgi->param('function')) && 
		($func = $fig->function_of($checkedL[0])))
	    {
		&assign_to_subtree($fig,$index,$user,$func,$checkedN[0],$to_peg);
	    }
	    elsif ($func = $cgi->param('function'))
	    {
		foreach $node ($cgi->param('checked_nonleaf'))
		{
		    &assign_to_subtree($fig,$index,$user,$func,$node,$to_peg);
		}
		
		foreach $peg ($cgi->param('checked_leaf'))
		{
		    &assign_func($fig,$peg,$user,$func);
		}
	    }
	    &display_initial_tree($fig,$cgi,$html,$user,$tree,$to_peg);
	}
	else
	{
	    &display_initial_tree($fig,$cgi,$html,$user,$tree,$to_peg);
	}
    }
    else
    {
	push(@$html,$cgi->h1('Could not parse the specified tree'));
    }
}

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


sub process_reroot {
    my($fig,$cgi,$html,$user,$tree,$node,$to_id,$to_peg) = @_;

    my $ali_dir   = $cgi->param('ali_dir');
    my $full_path = $cgi->param('full_path');
    my $ali_num   = $cgi->param('ali_num');
    if (! $full_path)
    {
	$ali_num =~ /^(\d+)\.(\d+)/;
	my $ali_numIa = $1;
	my $ali_numIb = $2;
	$full_path = "$ali_dir/$ali_numIa/$ali_numIb";
    }

    my $uprooted = &collapse_unnecessary_nodes(&uproot($tree));
    my $index = &tree_index_tables($uprooted);
    my $rerooted_tree = &root_tree($index,$to_id->{$node} ? $to_id->{$node} : $node,0.5);
    rename("$full_path/tree.dnd","$full_path/tree.dnd~");
    &write_newick($rerooted_tree,"$full_path/tree.dnd");
    &display_initial_tree($fig,$cgi,$html,$user,$rerooted_tree,$to_peg);
}

sub process_zoom {
    my($fig,$cgi,$html,$user,$tree,$node_for_zoom,$to_id,$to_peg) = @_;

    my $index = &tree_index_tables($tree);
    my $nodeP = &label_to_node($index,$node_for_zoom);
    $nodeP->[1] = 0;

    &display_initial_tree($fig,$cgi,$html,$user,$nodeP,$to_peg);
}

sub display_initial_tree {
    my($fig,$cgi,$html,$user,$tree,$to_peg) = @_;

    my $user      = $cgi->param('user');             
    my $ali_dir   = $cgi->param('ali_dir');
    my $ali_num   = $cgi->param('ali_num');
    my $full_path = $cgi->param('full_path');
    my $dump_xml = $cgi->param('xml');

    if ($cgi->param('collapse'))
    {
	$tree = &collapse_tree($fig,$cgi,$tree,$to_peg);
    }
    if ($dump_xml) {
	my $relabel = &xml_label_nodes($fig,$cgi,$to_peg,$tree);
	print "Content-type: text/html\n\n";
	&write_xml($tree, $relabel, $full_path, $cgi->param('distance'));
	exit;
    } 
    
    my $relabel = &label_nodes($fig,$cgi,$to_peg,$tree);
    push(@$html,$cgi->start_form(-action => "assign_using_tree.cgi",-method => 'post'),
                "<pre>",
	        &display_tree($tree,$relabel),
	        "</pre>\n",
	        $cgi->br,
	        $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	        $cgi->hidden(-name => 'ali_dir', -value => $ali_dir, -override => 1),
	        $cgi->hidden(-name => 'ali_num', -value => $ali_num, -override => 1),
	        $cgi->hidden(-name => 'full_path', -value => $full_path, -override => 1),
	        $cgi->submit(-value => "Redraw tree",-name => "Redraw tree"),$cgi->br,$cgi->br,
	        $cgi->submit(-value => "Reroot tree",-name => "Reroot tree"),$cgi->br,$cgi->br,
	        $cgi->submit(-value => "Delete subtrees",-name => "Delete subtrees"),$cgi->br,$cgi->br,
	        $cgi->submit(-value => "Show Alignment",-name => "Show Alignment"),$cgi->br,$cgi->br
	 );
    if ($full_path && ($full_path =~ /PHOB$/))
    {
	push(@$html,$cgi->submit(-value => "Reset tree",-name => "Reset tree"),$cgi->br,$cgi->br);
    }
    push(@$html,
	        $cgi->submit(-value => "Assign",-name => "make_assignment"),"&nbsp; &nbsp; Function: &nbsp;",
	        $cgi->textfield(-name => "function", -size => 80, -value => "", -override => 1),$cgi->br,
	        $cgi->hr
        );
    if ($cgi->param('Zoom to Subtree'))
    {
	push(@$html,$cgi->submit(-value => "Unzoom",-name => "Unzoom"),$cgi->br,$cgi->br);
    }
    else
    {
	push(@$html,$cgi->submit(-value => "Zoom to Subtree",-name => "Zoom to Subtree"),$cgi->br,$cgi->br);
    }	 

    my $collapse = $cgi->param('collapse') ? 1 : 0;
    my $check = $cgi->checkbox(-name => 'collapse', 
			       -value => 1, 
			       -checked => $collapse, 
			       -override => 1,
			       -label => 'Collapse Homogeneous Subtrees');

    push(@$html,$check);
    push(@$html,$cgi->end_form);
}

sub collapse_tree {
    my($fig,$cgi,$tree,$to_peg) = @_;

#    &print_tree($tree);
    my($tree,$func,$n) = &collapse1($fig,$cgi,$tree,$to_peg);
#    &print_tree($tree); die "aborted";

    return $tree;
}

sub collapse1 {
    my($fig,$cgi,$tree,$to_peg) = @_;
    my($i,$same);
    my $cc = &node_pointers($tree);
#    print STDERR "processing $tree->[0]\n";

    if (@$cc == 1)  # if we are at a leaf
    {
	my $func = $fig->function_of($to_peg->{&node_label($tree)});
	$func =~ s/\s*\#.*$//;
	return ($tree,$func,1);
    }
    else
    {
	$same = 1;
	$i = 1;
	my $func = undef;
	my $n = 0;
	my @newP; $newP[0] = $cc->[0];
	
	while ($i < @$cc)
	{
	    my($tree1,$func1,$n1) = &collapse1($fig,$cgi,$cc->[$i],$to_peg);

	    $n += $n1;
	    $newP[$i] = $tree1;
	    if ((! defined($func)) && defined($func1))
	    {
		$func = $func1;
	    }
	    else
	    {
		if ((! defined($func)) || (! defined($func1)) || ($func ne $func1))
		{
		    $same = 0;
		}
	    }
	    $i++;
	}

	if ($same)
	{
	    my $x = $to_peg->{$newP[1]->[0]};
	    $x =~ s/^\(\d+\)\s*//;
	    $to_peg->{$newP[1]->[0]} = "($n) " . $x;
	    $tree = [$newP[1]->[0],$tree->[1] + $newP[1]->[1],[$newP[0]]];
	}
	else
	{
	    for ($i=1; ($i < @$cc); $i++)
	    {
		$cc->[$i] = $newP[$i];
	    }
	    $func = undef;
	}
	return ($tree,$func,$n);
    }
}

sub label_nodes {
    my($fig,$cgi,$to_peg,$tree) = @_;
    my($id,$gs,$func,$check);

    my $ids = &ids_of_tree($tree);
    my $relabel = {};

    foreach $id (@$ids)
    {
	my $id0 = $to_peg->{$id} ? $to_peg->{$id} : $id;
	if ($id0 =~ /^(\(\d+\)\s+)?(fig\|\d+\.\d+\.peg\.\d+)/)
	{
	    my $count = $1 ? $1 : "";
	    my $id1 = $2;
	    $check = $cgi->checkbox(-name => 'checked_leaf', 
				    -value => $id1, 
				    -checked => 0, 
				    -override => 1,
				    -label => '');
	    $gs = $fig->org_of($id1);
	    $func = $fig->function_of($id1);
	    my $insub = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($id1);
	    if ($insub == 0) { $insub = "" }
	    elsif ($insub == 1) { $insub = "[in $insub subsystem]" }
	    else                { $insub = "[in $insub subsystems]" }
	    my $link = &HTML::fid_link($cgi,$id1);
	    $relabel->{$id} = "$count $check &nbsp; $link: $insub $gs &nbsp;&nbsp;&nbsp; $func";
	}
	else
	{
	    $check = $cgi->checkbox(-name => 'checked_nonleaf', 
				    -value => $id0, 
				    -checked => 0, 
				    -override => 1,
				    -label => '');
	    $relabel->{$id} = "$check &nbsp; $id0";
	}
    }
    return $relabel;
}

sub xml_label_nodes {
    my($fig,$cgi,$to_peg,$tree) = @_;
    my($id,$gs,$func,$check);

    my $ids = &ids_of_tree($tree);
    my $relabel = {};

    foreach $id (@$ids)
    {
	my $id0 = $to_peg->{$id} ? $to_peg->{$id} : $id;
	if ($id0 =~ /^(\(\d+\)\s+)?(fig\|\d+\.\d+\.peg\.\d+)/)
	{
	    my $count = $1 ? $1 : "";
	    my $id1 = $2;
	    $check = $cgi->checkbox(-name => 'checked_leaf', 
				    -value => $id1, 
				    -checked => 0, 
				    -override => 1,
				    -label => '');
	    $gs = $fig->org_of($id1);
	    $func = $fig->function_of($id1);
	    my @subs = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($id1);
	    #my $insub = grep { $fig->usable_subsystem($_) } $fig->peg_to_subsystems($id1);
	    my $numsub = @subs;
	    my $insub;
	    if ($numsub == 0) { 
	    		$insub = "";
			$relabel->{$id."subs"} = "";
	    } elsif ($numsub == 1) { 
	    	$insub = "[in $numsub subsystem]"; 
		$relabel->{$id."subs"} = join(":", @subs);
    	    }  else  { 
	    	$insub = "[in $numsub subsystems]";
		$relabel->{$id."subs"} = join(":", @subs);
		#print STDERR "INSUBS ", @subs, "Joined ", join(":", @subs), "\n";
            }
	    print STDERR "ID=$id, ID1=$id1\n";
	    my $link = &HTML::fid_link($cgi,$id1);
	    $relabel->{$id} = "$id1\n$insub\n$gs\n$func";
	    $relabel->{$id."checkbox"}  = "checked_leaf";
	    #$relabel->{$id} = "$count $check &nbsp; $link: $insub $gs &nbsp;&nbsp;&nbsp; $func";
	}
	else
	{
	    $check = $cgi->checkbox(-name => 'checked_nonleaf', 
				    -value => $id0, 
				    -checked => 0, 
				    -override => 1,
				    -label => '');
	    $relabel->{$id} = "$id0";
	    #$relabel->{$id}{checkbox}  = "checked_nonleaf";
	    #$relabel->{$id}{subs} = "";
	}
    }
    return $relabel;
}

sub assign_func {
    my($fig,$peg,$user,$function) = @_;

    if ($function ne $fig->function_of($peg))
    {
#	print STDERR "assigning $function to $peg (user=$user)\n"; die "aborted";

	#  Everyone is now master, and assign_function now adds annotation
	$fig->assign_function( $peg, $user, $function, "" );
    }
}

sub assign_to_subtree {
    my($fig,$index,$user,$func,$node,$to_peg) = @_;
    my($nodeP,$tips,$id);

    if ($nodeP = &label_to_node($index,$node))
    {
	$tips  = &tips_of_tree($nodeP);
	foreach $id (@$tips)
	{
	    &assign_func($fig,$to_peg->{$id},$user,$func);
	}
    }
}

sub write_cached_align
{
    my $cache = shift;
    my $file = "$FIG_Config::temp/$cache.align";
    gjoseqlib::print_alignment_as_fasta( $file, @_ );
}

sub write_cached_tree
{
    my ( $cache, $tree ) = @_;
    my $file = "$FIG_Config::temp/$cache.newick";
    open(TREE,">$file") || die "could not open $file";
    print TREE &tree_utilities::to_newick($tree),"\n";
    close(TREE);
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3