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

View of /FigWebServices/neighbor_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (annotate)
Mon Nov 15 22:40:59 2010 UTC (9 years ago) by redwards
Branch: MAIN
CVS Tags: mgrast_dev_08112011, mgrast_dev_08022011, rast_rel_2014_0912, myrast_rel40, mgrast_dev_05262011, mgrast_dev_04082011, mgrast_version_3_2, mgrast_dev_12152011, mgrast_dev_06072011, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2011_0119, 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, mgrast_dev_04012011, myrast_33, rast_rel_2011_0928, mgrast_dev_04052011, mgrast_dev_02222011, mgrast_dev_10262011, HEAD
A web page to make trees

#__perl__



use strict;
use FIG;
my $fig = new FIG;

use HTML;
use strict;

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

use gjophylip;
use gjonewicklib;

if (0)
{   
	my $VAR1;
	eval(join("",`cat $FIG_Config::temp/ma_cgi`));
	$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,">$FIG_Config::temp/ma_cgi"))
		{
			#print TMP &Dumper($cgi);
			close(TMP);
		}
	}
	exit;
}

my $html = [];



if ($cgi->param('request') ) 
{
	my @inputs;
	if ($cgi->param('data')) {
		$cgi->param('data') =~ s/\r//g;
		@inputs = split("\n", $cgi->param('data'));
	}

	elsif ($cgi->upload('uploadedfile'))
	{
		my $fh=$cgi->upload('uploadedfile');
		@inputs = <$fh> ;
	}
	else {
		die "You must provide some data";
	}
	
	chomp(@inputs);
	my $organisms;
	my $matrix;
	my $indata=0;
	my $label;

	foreach my $i (@inputs) {
		if ($i =~ m#^//$#) {
			$indata=1;
			next;
		}
		if ($indata) {
			my @row=split /\t/, $i;
			push @$matrix, \@row;
		}
		else {
			my @row=split /\t/, $i;
			$organisms->[$row[0]]=\@row;
			$label->[$row[0]] = $row[1] . "($row[2] : $row[3] : $row[4] )";
		}
	}

	# generate a distance matrix and make both halves the same.
	# complain if the halves are not the same.
	for (my $i=0; $i<=$#$matrix; $i++) {
		for (my $j=0; $j<$i; $j++) {
			if (defined $matrix->[$i]->[$j]) {
				if (defined $matrix->[$j]->[$i] && $matrix->[$i]->[$j] != $matrix->[$j]->[$i]) {
					print STDERR "Warning: Averaging your matrix at positions $i and $j. The matrix is not symmetric, so we're averaging them\n";
					$matrix->[$i]->[$j] = $matrix->[$j]->[$i] =  1 - ($matrix->[$i]->[$j] + $matrix->[$j]->[$i])/2;
					next;
				}
				$matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - $matrix->[$i]->[$j];
			}
			elsif (defined $matrix->[$j]->[$i]) {
				if (defined $matrix->[$i]->[$j] && $matrix->[$i]->[$j] != $matrix->[$j]->[$i]) {
					print STDERR "Warning: Averaging your matrix at positions $i and $j. The matrix is not symmetric, so we're averaging them\n";
					$matrix->[$i]->[$j] = $matrix->[$j]->[$i] =  1 - ($matrix->[$i]->[$j] + $matrix->[$j]->[$i])/2;
					next;
				}
				$matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - $matrix->[$j]->[$i];
			}
			else {
				print STDERR "Uh oh, no data set at matrix($i, $j) or matrix($j, $i), so set to 1\n";
				$matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1;
			}
		}
	}

	# now fix self!
	for (my $i=0; $i<=$#$matrix; $i++) {$matrix->[$i]->[$i]=0}

	# now add the names
	my $n=0;
	#map {unshift @{$matrix->[$_]}, "id$n"; $n++} (0 .. $#$matrix);
	map {unshift @{$matrix->[$_]}, $label->[$n]; $n++} (0 .. $#$matrix);

	#push @$html,  "<pre>", Dumper($matrix), "</pre>";
	#push @$html, "<pre>\n";
	#map {push @$html, join("\t", @$_), "\n"} @$matrix;
	#push @$html, "</pre>\n";

	my %treeopts = ( tree_format => "gjo" );
	my $tree = gjophylip::neighbor($matrix, \%treeopts);
	#push @$html, "<pre>", Dumper($matrix), "</pre>";
	#my $tree = gjophylip::neighbor($matrix);

	#push @$html,  "<pre>", Dumper($tree), "</pre>";
	#%treeopts = ( html=>1 );
	#my @res =  gjonewicklib::text_plot_newick( $tree, \%treeopts );
	push @$html,  "<pre>", join("\n", gjonewicklib::text_plot_newick( $tree, \%treeopts )), "</pre>";
		
	push @$html, "<p><hr width=\"75%\"/> &nbsp; </p>";
}

push(@$html,$cgi->start_multipart_form(-action => "./neighbor_tree.cgi"));
push(@$html,
	"Please choose a distance matrix file to draw a simple tree from it. The matrix can either be a distance matrix -- where 0 means things are the same, or a similarity matrix, where 1 means things are the same. However, the numbers should always be between 0 and 1. We will also check that your matrix is symmetric. You may either upload the matrix or paste it here, but either way the matrix should be tab-separated text. This is designed to work with output from myRast!", $cgi->p, 
	"Please choose a file: &nbsp; ", $cgi->filefield(-name=>"uploadedfile") , $cgi->p, "\n", 
	"Or paste some data here: &nbsp; ", $cgi->textarea(-rows=>20, -cols=>80, -name=>"data"),  $cgi->p, "\n",
	"Is your data a ", $cgi->radio_group(-name=>"matrixtype", -values=>["similarity", "distance"], -default=>"similarity"), $cgi->p,
	$cgi->submit(-name=>"request"), $cgi->reset, $cgi->end_form,
);

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










MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3