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

Annotation of /FigWebServices/heat_map.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download)

1 : overbeek 1.1 #__perl__
2 :    
3 :     =pod
4 :    
5 :     =head1 heat_map.cgi
6 :    
7 :     A simple "microarray" like program that I wanted. Just display a table with no borders, where the rows are the ss and the cols are the samples, and the cells are the intensity
8 :    
9 :     A gui representation of data. I want to represent the connections to subsystems between different genomes. This allows us to compare the relative amounts of each metabolism occuring in each genome.
10 :    
11 :     The connections to subsystems are stored as attributes, and are generated by the script:
12 :    
13 :     get_ss_connections
14 :    
15 :     =cut
16 :    
17 :     use strict;
18 :     use FIG;
19 :     use HTML;
20 :     use CGI;
21 :     use FIG_CGI;
22 :     use CGI::Carp qw(fatalsToBrowser);
23 :     my $html=["<TITLE>Heat Map NQ</title>"];
24 :     use raelib;
25 :     use raedraw;
26 :     my $raedraw=new raedraw;
27 :     my $raelib=new raelib;
28 :    
29 :     my ($fig, $cgi, $user);
30 :     eval {
31 :     ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0,
32 :     debug_load => 0,
33 :     print_params => 0);
34 :     };
35 :    
36 :     if ($@ ne ""){
37 :     my $err = $@;
38 :    
39 :     my(@html);
40 :    
41 :     push(@html, $cgi->p("Error connecting to SEED database."));
42 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
43 :     {
44 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
45 :     }
46 :     else
47 :     {
48 :     push(@html, $cgi->pre($err));
49 :     }
50 :     &HTML::show_page($cgi, \@html, 1, undef, {"default"=>"Html/css/heatmap.css"});
51 :     exit;
52 :     }
53 :    
54 :    
55 :    
56 :     unless ($cgi->param("korgs"))
57 :     {
58 :     my %options;
59 :     map {$options{$_} = $fig->genus_species($_) . " ($_)"} &genomes_with_cnx();
60 :    
61 : overbeek 1.3 my %limit=(""=>1, "unclassified"=>1);
62 : overbeek 1.1 foreach my $ssc ($fig->all_subsystem_classifications()) {$limit{$ssc->[0]}=1}
63 :    
64 : overbeek 1.2 unless ($cgi->param('complete')) {$cgi->param('complete', 'All')}
65 :    
66 : overbeek 1.1 # logo
67 :     # $cgi->p({style=>"text-align: center;"}, $cgi->a({href=>$cgi->url}, $cgi->img({alt=>"Heat Map NR", src=>"/heatmapnq.png"}))),
68 :    
69 :     push @$html, (
70 :     $cgi->start_form(),
71 :     $cgi->h2("Heat Map NQ"),
72 :     $cgi->p(
73 :     "Heat map NQ is designed to show relationships between subsystems in different genomes. This is the prototype\n",
74 :     "My reccommendation is that you display different areas of metabolism, with non-quantitative differences grouped in either 5 or 10 groups.\n",
75 :     "You can also see the raw data by using the quantitative analysis. For this version, you can not select genomes (that will be coming), and so ",
76 :     "if you compare all of metabolism the non-quantitative analysis will be biased by one or two outliers\n",
77 :     "You can also overcome the outlier effect by trimming off the maximums, so that anything above that value is set as the maximum. Note that the ",
78 :     " maximum value is from the un-modified raw score.",
79 :     ),
80 :     $cgi->h2("Dataset"),
81 :     $cgi->p(
82 :     $cgi->br("Please choose some genomes: &nbsp; ",
83 :     $raelib->scrolling_org_list($cgi, 1, 0, [&genomes_with_cnx()]),
84 :     $cgi->br("Please choose a subset to show: &nbsp; ", $cgi->popup_menu(-name=>"limit", -values=>[sort {uc($a) cmp uc($b)}keys %limit], -default=>""), " &nbsp; (leave blank to see all of metabolism\n"),
85 :     )),
86 :     $cgi->h2("Non-quantitative Analysis"),
87 :     $cgi->p(
88 :     $cgi->p("Non quantitive analysis groups the data into a set of groups and colors the boxes accordingly. This is the default that you should probably use.\n"),
89 :     $cgi->br("Number of groups: &nbsp; ", $cgi->textfield(-name=>"ng", -default=>5, -size=>3)),
90 :     $cgi->br("Effective raw score maximum: &nbsp; ", $cgi->textfield(-name=>"fmax", -size=>5), " (a good value for this is about .01)\n"),
91 :     ),
92 :     $cgi->h2("Quantitative Analysis"),
93 :     $cgi->p(
94 :     $cgi->p("Quantitive analysis will show you the number of subsystems in each sample. This is the ratio of the number of times that subsystem is hit to the total number of subsystems that are found in the sample.\n The ratio is multiplied by a fiddle factor to normalize the data. Set the multiplier here, or use the default\n"),
95 :     $cgi->br($cgi->checkbox(-name=>"quant", -label=>"Use quantitative analysis")," &nbsp; Multiplier: &nbsp; ", $cgi->textfield(-name=>"fiddle", -default=>5000, -size=>5)),
96 :     ),
97 :     $cgi->h2("Display"),
98 :     $cgi->p(
99 :     "The default is to use a blue color as the extreme, but you can change that to red or green\n",
100 :     $cgi->br($cgi->popup_menu(-name=>"color", -label=>"Default color scheme", -values=>['blue', 'red', 'green'], -default=>'blue')),
101 :     ),
102 :     $cgi->submit, $cgi->reset, $cgi->end_form());
103 :    
104 :     &HTML::show_page($cgi, $html, 1, undef, {"default"=>"Html/css/heatmap.css"});
105 :     exit(0);
106 :     }
107 :    
108 :    
109 :    
110 :    
111 :     my @genomes=$cgi->param('korgs');
112 :     my $scores; my $max;
113 :     for (my $i=0; $i<=$#genomes; $i++)
114 :     {
115 :     next unless ($fig->is_genome($genomes[$i]));
116 :     foreach my $attr ($fig->get_attributes($genomes[$i], "ss_connections"))
117 :     {
118 : overbeek 1.4 $attr->[2] =~ /^(.*):(([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)/;
119 : overbeek 1.1 my ($ss, $score)=($1, $2);
120 :     unless ($ss && defined $score) {die "Can't parse a ss and a score from ".(join("\n", @$attr))}
121 :     ($score > $max) ? ($max=$score) : 1;
122 :     unless (defined $scores->{$ss}) {$#{$scores->{$ss}}=$#genomes}
123 :     $scores->{$ss}->[$i]=$score;
124 :     }
125 :     }
126 :    
127 :     my @data;
128 :     foreach my $ss (keys %$scores)
129 :     {
130 :     my @class=@{$fig->subsystem_classification($ss)};
131 : overbeek 1.3 if (
132 :     (
133 :     $cgi->param('limit') &&
134 :     ($cgi->param('limit') eq "unclassified" && !$class[0]) ||
135 :     ($cgi->param('limit') eq $class[0])
136 :     ) ||
137 :     !$cgi->param('limit')
138 :     )
139 : overbeek 1.1 {
140 :     push @data, [@class, $ss, @{$scores->{$ss}}];
141 :     }
142 :     }
143 :    
144 :     #fix the effective maximum if we have set it
145 :     ($cgi->param('fmax')) ? ($max=$cgi->param('fmax')) : 1;
146 :    
147 :     unless ($data[0] && $max)
148 :     {
149 :     push @$html,
150 :     (
151 :     $cgi->p({style=>'color: red; background-color: yellow; font-size: 1.2em; font-weight: bolder;'}, "Sorry, no subsystems matched your query. <br>Please use your back button to try again"),
152 :     );
153 :     &HTML::show_page($cgi, $html, 1, undef, {"default"=>"Html/css/heatmap.css"});
154 :     exit(0);
155 :     }
156 :    
157 :    
158 :     # now we have the max, we need to figure out what the groups are.
159 :     # we want $ng groups, and so mapping will have the range from 0 to 100
160 :     # @mapping has all the data, in order
161 :     my $ng=$cgi->param('ng');
162 :     my @mapping=(0);
163 :     my %mapped = (0=>0);
164 :     my $count=int(100/$ng);
165 :     for (my $i=$max/$ng; $i<= ($max-($max/$ng)); $i+=$max/$ng)
166 :     {
167 :     push @mapping, $i;
168 :     $mapped{$i}=$count;
169 :     $count+=int(100/$ng);
170 :     }
171 :     # define $max as 100
172 :     push @mapping, 100;
173 :     $mapped{100}=100;
174 :    
175 :     my $tab;
176 :     foreach my $a (@data)
177 :     {
178 :     # delete this part to remove the links to the ss
179 :     my $ssn=$a->[2];
180 :     $ssn =~ s/ /_/g;
181 :     $a->[2] = &HTML::sub_link($cgi, $a->[2]);
182 :    
183 :     my @row;
184 :     foreach my $cell (@$a)
185 :     {
186 :     if ($raelib->is_number($cell)) {
187 :     if ($cgi->param('quant'))
188 :     {
189 :     $cell *= $cgi->param('fiddle');
190 :     }
191 :     else
192 :     {
193 :     my $changed;
194 :     for (my $i=0; $i<=$#mapping; $i++)
195 :     {
196 :     last if ($changed);
197 :     if ($cell < $mapping[$i]) {$cell=$mapped{$mapping[$i]}; $changed=1}
198 :     }
199 :     unless ($changed) {$cell=100}
200 :     }
201 :     my @color=$raedraw->heat_map_color($cell, $cgi->param('color'));
202 :     my $bgcolor;
203 :     map {$_=int($_*255); $bgcolor.=sprintf("%x", $_)} @color;
204 :     $cell =~ s/(\.\d\d)\d+/$1/;
205 :     push @row, [" $cell ", "td bgcolor='#$bgcolor' align='center'"]
206 :     #push @row, [" $cell ($hue) ", "td"]
207 :     }
208 :     elsif (!defined $cell) {push @row, [" &nbsp; ", "td"]}
209 :     else {push @row, [$cell, "td"]}
210 :     }
211 :     push @$tab, \@row;
212 :     }
213 :    
214 :     @$tab=sort {$a->[0]->[0] cmp $b->[0]->[0]} @$tab;
215 :    
216 :     # merge the table
217 :     # skip the data columns
218 :     my $skip;
219 :     map {$skip->{$_}=1} (2..10);
220 :     unless ($cgi->param('create_excel')) {$tab=&HTML::merge_table_rows($tab, $skip)}
221 :    
222 :     # finally make the HTML
223 :    
224 :    
225 :     my $border=0;
226 :     if ($cgi->param('border')) {$border=1}
227 :     my @headers=("Class 1", "Class 2", "Subsystem");
228 :     push @headers, map {$fig->genus_species($_) . "<br />$_"} @genomes;
229 :    
230 :     my %options=("border"=>0);
231 :     if ($cgi->param('create_excel')) {$options{"excelfile"}="SubsystemConnections"}
232 :    
233 :     # this is the link to the logo, which I removed
234 :     # $cgi->p({style=>"text-align: center;"}, $cgi->a({href=>$cgi->url}, $cgi->img({alt=>"Heat Map NR", src=>"/heatmapnq.png"}))),
235 :    
236 :     $cgi->submit("create_excel", "Create excel file");
237 :     push @$html,
238 :     (
239 :     $cgi->start_form,
240 :     $cgi->hidden('korgs'),
241 :     $cgi->hidden('border'),
242 :     $cgi->hidden('fiddle'),
243 :     $cgi->hidden('quant'),
244 :     $cgi->hidden('ng'),
245 :     $cgi->hidden('fmax'),
246 :     $cgi->hidden('limit'),
247 :     $cgi->hidden('color'),
248 :     &HTML::make_table([], &control_color_table(), ""),
249 :     &HTML::make_table(\@headers, $tab, "", %options),
250 :     $cgi->submit("create_excel", "Create excel file of this table"),
251 :     );
252 :    
253 :     &HTML::show_page($cgi, $html, 1, undef, {"default"=>"Html/css/heatmap.css"});
254 :    
255 :     exit(0);
256 :    
257 :    
258 :     sub genomes_with_cnx {
259 :     my %gcx;
260 :     foreach my $attr ($fig->get_attributes(undef, "ss_connections"))
261 :     {
262 :     $gcx{$attr->[0]}=1;
263 :     }
264 :     return keys %gcx;
265 :     }
266 :    
267 :     sub control_color_table {
268 :     # controltab is the table at the top that shows what the colors are.
269 :     my $controltab;
270 :     {
271 :     my $row;
272 :     for (my $i=0; $i<=100; $i+=2)
273 :     {
274 :     my @color=$raedraw->heat_map_color($i, $cgi->param('color'));
275 :     my $bgcolor;
276 :     map {$_=int($_*255); $bgcolor.=sprintf("%x", $_)} @color;
277 :     push @$row, [" $i ", "td bgcolor='#$bgcolor' align='center'"];
278 :     #if ($i && !($i % 20)) {push @$controltab, $row; undef $row}
279 :     }
280 :     push @$controltab, $row;
281 :     }
282 :     return $controltab;
283 :     }
284 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3