#__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 "
\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, "", Dumper($matrix), ""; #push @$html, "\n"; #map {push @$html, join("\t", @$_), "\n"} @$matrix; #push @$html, "\n"; my %treeopts = ( tree_format => "gjo" ); my $tree = gjophylip::neighbor($matrix, \%treeopts); #push @$html, "", Dumper($matrix), ""; #my $tree = gjophylip::neighbor($matrix); #push @$html, "", Dumper($tree), ""; #%treeopts = ( html=>1 ); #my @res = gjonewicklib::text_plot_newick( $tree, \%treeopts ); push @$html, "", join("\n", gjonewicklib::text_plot_newick( $tree, \%treeopts )), ""; push @$html, "
"; } 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: ", $cgi->filefield(-name=>"uploadedfile") , $cgi->p, "\n", "Or paste some data here: ", $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;