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

Annotation of /FigWebServices/neighbor_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : redwards 1.1 #__perl__
2 :    
3 :    
4 :    
5 :     use strict;
6 :     use FIG;
7 :     my $fig = new FIG;
8 :    
9 :     use HTML;
10 :     use strict;
11 :    
12 :     use CGI;
13 :     use CGI::Carp qw/fatalsToBrowser/;
14 :     my $cgi = new CGI;
15 :    
16 :     use gjophylip;
17 :     use gjonewicklib;
18 :    
19 :     if (0)
20 :     {
21 :     my $VAR1;
22 :     eval(join("",`cat $FIG_Config::temp/ma_cgi`));
23 :     $cgi = $VAR1;
24 :     # print STDERR &Dumper($cgi);
25 :     }
26 :    
27 :     if (0)
28 :     {
29 :     print $cgi->header;
30 :     my @params = $cgi->param;
31 :     print "<pre>\n";
32 :     foreach $_ (@params)
33 :     {
34 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
35 :     }
36 :    
37 :     if (0)
38 :     {
39 :     if (open(TMP,">$FIG_Config::temp/ma_cgi"))
40 :     {
41 :     #print TMP &Dumper($cgi);
42 :     close(TMP);
43 :     }
44 :     }
45 :     exit;
46 :     }
47 :    
48 :     my $html = [];
49 :    
50 :    
51 :    
52 :     if ($cgi->param('request') )
53 :     {
54 :     my @inputs;
55 :     if ($cgi->param('data')) {
56 :     $cgi->param('data') =~ s/\r//g;
57 :     @inputs = split("\n", $cgi->param('data'));
58 :     }
59 :    
60 :     elsif ($cgi->upload('uploadedfile'))
61 :     {
62 :     my $fh=$cgi->upload('uploadedfile');
63 :     @inputs = <$fh> ;
64 :     }
65 :     else {
66 :     die "You must provide some data";
67 :     }
68 :    
69 :     chomp(@inputs);
70 :     my $organisms;
71 :     my $matrix;
72 :     my $indata=0;
73 :     my $label;
74 :    
75 :     foreach my $i (@inputs) {
76 :     if ($i =~ m#^//$#) {
77 :     $indata=1;
78 :     next;
79 :     }
80 :     if ($indata) {
81 :     my @row=split /\t/, $i;
82 :     push @$matrix, \@row;
83 :     }
84 :     else {
85 :     my @row=split /\t/, $i;
86 :     $organisms->[$row[0]]=\@row;
87 :     $label->[$row[0]] = $row[1] . "($row[2] : $row[3] : $row[4] )";
88 :     }
89 :     }
90 :    
91 :     # generate a distance matrix and make both halves the same.
92 :     # complain if the halves are not the same.
93 :     for (my $i=0; $i<=$#$matrix; $i++) {
94 :     for (my $j=0; $j<$i; $j++) {
95 :     if (defined $matrix->[$i]->[$j]) {
96 :     if (defined $matrix->[$j]->[$i] && $matrix->[$i]->[$j] != $matrix->[$j]->[$i]) {
97 :     print STDERR "Warning: Averaging your matrix at positions $i and $j. The matrix is not symmetric, so we're averaging them\n";
98 :     $matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - ($matrix->[$i]->[$j] + $matrix->[$j]->[$i])/2;
99 :     next;
100 :     }
101 :     $matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - $matrix->[$i]->[$j];
102 :     }
103 :     elsif (defined $matrix->[$j]->[$i]) {
104 :     if (defined $matrix->[$i]->[$j] && $matrix->[$i]->[$j] != $matrix->[$j]->[$i]) {
105 :     print STDERR "Warning: Averaging your matrix at positions $i and $j. The matrix is not symmetric, so we're averaging them\n";
106 :     $matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - ($matrix->[$i]->[$j] + $matrix->[$j]->[$i])/2;
107 :     next;
108 :     }
109 :     $matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1 - $matrix->[$j]->[$i];
110 :     }
111 :     else {
112 :     print STDERR "Uh oh, no data set at matrix($i, $j) or matrix($j, $i), so set to 1\n";
113 :     $matrix->[$i]->[$j] = $matrix->[$j]->[$i] = 1;
114 :     }
115 :     }
116 :     }
117 :    
118 :     # now fix self!
119 :     for (my $i=0; $i<=$#$matrix; $i++) {$matrix->[$i]->[$i]=0}
120 :    
121 :     # now add the names
122 :     my $n=0;
123 :     #map {unshift @{$matrix->[$_]}, "id$n"; $n++} (0 .. $#$matrix);
124 :     map {unshift @{$matrix->[$_]}, $label->[$n]; $n++} (0 .. $#$matrix);
125 :    
126 :     #push @$html, "<pre>", Dumper($matrix), "</pre>";
127 :     #push @$html, "<pre>\n";
128 :     #map {push @$html, join("\t", @$_), "\n"} @$matrix;
129 :     #push @$html, "</pre>\n";
130 :    
131 :     my %treeopts = ( tree_format => "gjo" );
132 :     my $tree = gjophylip::neighbor($matrix, \%treeopts);
133 :     #push @$html, "<pre>", Dumper($matrix), "</pre>";
134 :     #my $tree = gjophylip::neighbor($matrix);
135 :    
136 :     #push @$html, "<pre>", Dumper($tree), "</pre>";
137 :     #%treeopts = ( html=>1 );
138 :     #my @res = gjonewicklib::text_plot_newick( $tree, \%treeopts );
139 :     push @$html, "<pre>", join("\n", gjonewicklib::text_plot_newick( $tree, \%treeopts )), "</pre>";
140 :    
141 :     push @$html, "<p><hr width=\"75%\"/> &nbsp; </p>";
142 :     }
143 :    
144 :     push(@$html,$cgi->start_multipart_form(-action => "./neighbor_tree.cgi"));
145 :     push(@$html,
146 :     "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,
147 :     "Please choose a file: &nbsp; ", $cgi->filefield(-name=>"uploadedfile") , $cgi->p, "\n",
148 :     "Or paste some data here: &nbsp; ", $cgi->textarea(-rows=>20, -cols=>80, -name=>"data"), $cgi->p, "\n",
149 :     "Is your data a ", $cgi->radio_group(-name=>"matrixtype", -values=>["similarity", "distance"], -default=>"similarity"), $cgi->p,
150 :     $cgi->submit(-name=>"request"), $cgi->reset, $cgi->end_form,
151 :     );
152 :    
153 :     &HTML::show_page($cgi,$html);
154 :     exit;
155 :    
156 :    
157 :    
158 :    
159 :    
160 :    
161 :    
162 :    
163 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3