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

Annotation of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 : olson 1.12 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : redwards 1.1
20 :     =pod
21 :    
22 :     =head1 subsys_vectors.cgi
23 :    
24 :     Subsystem vectors is a page for displaying information about the functional variants for different subsystems in different genomes. The basic idea is to present a spreadsheet where the rows are organisms and the columns are subsystems. The cells will be variant codes.
25 :    
26 :     We will add the ability to sort the table by any individual subsystem, genus species information, or taxonomy.
27 :    
28 :     Coloring will be done by css with some css code somewhere (not sure where yet). Each cell will be given a class equal to subsysname."_".functionalvariant. If you set the value of $color{subsysname."_".functionalvariant} it will be set the color of the cell using css. hopefully.
29 :    
30 : redwards 1.5 There are two different variants of this code. If the cgi->param('nmpdr') is true, only a limited subset of functionality will be display. This is for the links from the NMPDR sites.
31 :    
32 : redwards 1.1 =cut
33 :    
34 :     use strict;
35 :     use FIG;
36 :     use HTML;
37 :     use raelib;
38 :     my $raelib=new raelib;
39 :     use CGI;
40 :     my $cgi=new CGI;
41 :    
42 :     my $fig;
43 :     eval {
44 :     $fig = new FIG;
45 :     };
46 :    
47 :     if ($@ ne "")
48 :     {
49 :     my $err = $@;
50 :    
51 :     my(@html);
52 :    
53 :     push(@html, $cgi->p("Error connecting to SEED database."));
54 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
55 :     {
56 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
57 :     }
58 :     else
59 :     {
60 :     push(@html, $cgi->pre($err));
61 :     }
62 :     &HTML::show_page($cgi, \@html, 1);
63 :     exit;
64 :     }
65 :    
66 :     my $html = [];
67 :     my $user = $cgi->param('user');
68 :    
69 :     unshift(@$html, "<TITLE>The SEED - Subsystem Vectors</TITLE>\n");
70 :    
71 :    
72 :    
73 : redwards 1.9 if (($cgi->param('korgs') || $cgi->param('orgname')) && ($cgi->param('subsystems') || $cgi->param('allss')))
74 : redwards 1.1 {
75 :     &show_table($fig,$cgi,$html);
76 :     }
77 :     else
78 :     {
79 :     &show_initial($fig,$cgi,$html);
80 :     }
81 :    
82 :     &HTML::show_page($cgi,$html,1);
83 :     exit;
84 :    
85 :    
86 :     sub show_initial {
87 :     my ($fig,$cgi,$html)=@_;
88 :     # generate a blank page
89 :     push @$html,
90 :     $cgi->start_form(),
91 :     $cgi->p("Please enter your username: &nbsp; ", $cgi->textfield("user")),
92 : redwards 1.9 "You can enter the partial name of some organisms to choose from (e.g. Listeria): ", $cgi->textfield(-name=>"orgname", -size=>40), $cgi->p, "\n",
93 : redwards 1.1 $cgi->p("Please choose some organisms from the list. You can choose more than one organism:"),
94 :     $raelib->scrolling_org_list($cgi, 1),
95 : redwards 1.9 $cgi->p("Please choose some subsystems from the list. You can choose more than one subsystem from the list or check this box to select them all",
96 :     $cgi->checkbox(-name=>"allss", -label=>'')), "\n",
97 : redwards 1.1 $raelib->scrolling_subsys_list($cgi, 1),
98 : redwards 1.5 $cgi->p, $cgi->checkbox(-name=>'showempty', -label=>"Show empty columns"), $cgi->p,
99 :     $cgi->checkbox(-name=>'showclassifications', -checked=>1, -label=>"Show classifications"), $cgi->p;
100 : redwards 1.3
101 :     # just define the sort order
102 :     my $c=1;
103 :     foreach my $s (sort {uc($a) cmp uc($b)} $fig->all_subsystems) {push @$html, $cgi->hidden("sort$s", $c); $c++}
104 :    
105 : redwards 1.5 push @$html, $cgi->submit, $cgi->reset, $cgi->end_form;
106 : redwards 1.1 return $html;
107 :     }
108 :    
109 :     sub show_table {
110 :     my ($fig,$cgi,$html)=@_;
111 :     # what genomes are we interested in?
112 : redwards 1.9 my @genomes;
113 :     # partial genome name matching
114 :     if ($cgi->param('orgname')) {
115 : redwards 1.10 @genomes=$fig->partial_genus_matching($cgi->param('orgname'), 1);
116 : redwards 1.9 $cgi->param('korgs', @genomes)
117 :     }
118 :     else {
119 :     @genomes=$cgi->param('korgs');
120 :     }
121 : redwards 1.1 # and subsystems
122 : redwards 1.9 my @ss;
123 :     if ($cgi->param('allss')) {
124 :     @ss=$fig->all_subsystems;
125 :     $cgi->param('subsystems', @ss);
126 :     }
127 :     else {@ss=$cgi->param('subsystems')}
128 : redwards 1.1 # go through the subsystems and get the variant codes
129 :     # we do this first because we can load a subsystem and then get all vcs for it. Then when we do the table, we buuild it
130 :     # genome by genome and not col by col
131 : redwards 1.5 my $vc; my $class;
132 : redwards 1.1 foreach my $ss (@ss) {
133 :     my $subsystem=$fig->get_subsystem($ss);
134 : redwards 1.5 $vc->{$ss}=undef; # this is so the keys later on work fine
135 : redwards 1.1 foreach my $gen (@genomes) {
136 : redwards 1.5 if (defined $subsystem->get_variant_code_for_genome($gen)) {$vc->{$ss}->{$gen}=$subsystem->get_variant_code_for_genome($gen)};
137 :     }
138 :     $class->{$ss}=$fig->subsystem_classification($ss);
139 :     unless ($class->{$ss}->[0]) {$class->{$ss}=["Unclassified", '']}
140 :     }
141 :    
142 :     # now we want to remove any subsystem that is entirely blank
143 :     my @removed;
144 :     unless ($cgi->param('showempty')) {
145 :     foreach my $ss (keys %$vc) {
146 :     my $keep=0;
147 :     foreach my $gen (keys %{$vc->{$ss}}) {
148 :     if (exists $vc->{$ss}->{$gen}) {$keep=1; last}
149 :     }
150 :     next if ($keep);
151 :     # if we get here the column is empty, so we delete the ss, and put it in @removed.
152 :     push @removed, $ss;
153 :     delete $vc->{$ss};
154 : redwards 1.1 }
155 :     }
156 : redwards 1.5
157 : redwards 1.1
158 : redwards 1.5 my @labels=$raelib->subsys_names_for_display(@ss);
159 :     my %label;
160 :     foreach my $i (0 .. @ss) {$label{$ss[$i]}=$labels[$i]}
161 :    
162 :     # sort the columns in the appropriate way
163 : redwards 1.9
164 :     my %tempkey;
165 : redwards 1.11 foreach (@ss) {$tempkey{$_}=$cgi->param("sort$_") or "1"} # this is a fake so if $cgi->param("sort$_") is undef it is still sorted
166 : redwards 1.8 @ss=sort {
167 : redwards 1.11 $tempkey{$a} <=> $tempkey{$b} ||
168 : redwards 1.5 uc($class->{$a}->[0]) cmp uc($class->{$b}->[0]) ||
169 :     uc($class->{$a}->[1]) cmp uc($class->{$b}->[1])
170 :     } keys %$vc;
171 : redwards 1.1
172 :     # now generate the table header
173 : redwards 1.5 my $col_hdrs=["Genome ID", "Organism"];
174 :    
175 :     # note the first two columns are now put in later, when we merge things.
176 :     #my $class1=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
177 :     #my $class2=[]; # note that the first 2 cols of class2 is from the rowspan in the previous line
178 :    
179 :     my $class1=[];
180 :     my $class2=[];
181 : redwards 1.1
182 : redwards 1.5 my $i=2;
183 :     foreach my $ss (@ss) {
184 : overbeek 1.13 push @$col_hdrs, "<a href='subsys.cgi?user=$user&ssa_name=$ss&request=show_ssa&can_alter=&check=&sort=by_phylo&show_clusters=1' target='_blank'>$label{$ss}</a>";
185 : redwards 1.5 push @$class1, ($class->{$ss}->[0] or "Unclassified");
186 :     push @$class2, ($class->{$ss}->[1] or '');
187 :     $i++;
188 : redwards 1.1 }
189 :    
190 : redwards 1.5 # merge adjacent columns that are the same. We use a temp array to hold the data while we do this
191 :     my $temp=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
192 :     my $i=0;
193 :     while ($i<=$#$class1) {
194 :     my $colspan=1;
195 :     while ($i <= $#$class1 && $class1->[$i] eq $class1->[$i+1]) {$colspan++; $i++}
196 :     push @$temp, [$class1->[$i], "td colspan=$colspan style='text-align: center'"];
197 :     $i++;
198 :     }
199 :     $class1=$temp;
200 :     # do the same thing for the bottom column
201 :     $temp=[];
202 :     my $i=0;
203 :     while ($i<=$#$class2) {
204 :     my $colspan=1;
205 :     while ($i <= scalar(@$class2) && $class2->[$i] eq $class2->[$i+1]) {$colspan++; $i++}
206 :     push @$temp, [$class2->[$i], "td colspan=$colspan style='text-align: center'"];
207 :     $i++;
208 :     }
209 :     $class2=$temp;
210 :    
211 : redwards 1.1 my $tab=[];
212 : redwards 1.5 # finally build the table
213 : redwards 1.1 foreach my $gen (@genomes) {
214 :     my $row=[
215 :     [$gen, "td class='genomeid'"],
216 :     [$fig->genus_species($gen), "td class='genus_species'"]
217 :     ];
218 :     foreach my $ss (@ss) {
219 : redwards 1.5 if (exists $vc->{$ss}->{$gen}) {
220 :     push @$row, [$vc->{$ss}->{$gen}, "td class='".${ss}."_".$vc->{$ss}->{$gen}."' style='text-align: center'"];
221 :     }
222 :     else {
223 :     push @$row, " &nbsp; ";
224 :     }
225 : redwards 1.1 }
226 :     push @$tab, $row;
227 :     }
228 :    
229 :     my $sort=$cgi->param('sortby');
230 :     if ($sort =~ /^\d+$/) {
231 :     # sort by a column number
232 :     # all columns are refs to arrays, so we sort on the first element in the ref that defines the cell.
233 :     # we sort on the $sort value which is the name of the column.
234 :     # and we sort the rows of the table as $a and $b
235 :     @$tab=sort {$a->[$sort]->[0] cmp $b->[$sort]->[0]} @$tab;
236 :     }
237 :     elsif ($sort eq "by_phylo")
238 :     {
239 :     # stolen from subsys.cgi
240 :     $tab = [map { $_->[0] }
241 :     sort { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
242 :     map { [$_, $fig->taxonomy_of($_->[0]->[0])] }
243 :     @$tab];
244 :     }
245 :     elsif ($sort eq "by_tax_id")
246 :     {
247 : redwards 1.5 $tab = [sort {$a->[0] <=> $b->[0]} @$tab];
248 : redwards 1.1 }
249 :    
250 : redwards 1.5 # we are going to build the top three or four rows in reverese order. We do this after the column sort to make sure that it works
251 :     #now add a radio button column to allow sorting of rows by column
252 :     my $sortcol=["<b>Sort by column</b>", "<input type='radio' name='sortby' value='1'>"];
253 :     foreach my $i (2..$#ss+2) {push @$sortcol, "<input type='radio' name='sortby' value='$i'>"}
254 :     unshift @$tab, $sortcol;
255 :    
256 :     # we want to add the first line of the table which has the default sort order
257 : redwards 1.3 my $firstrow=[['<b>Column Order</b>', 'td colspan=2 style="text-align: center"']];
258 :     for (my $i=0; $i<scalar(@ss); $i++) {
259 : redwards 1.4 push @$firstrow, [$cgi->textfield(-name=>"sort$ss[$i]", -size=>4, -default=>$i+1, -override=>1), "td style='text-align: center'"];
260 : redwards 1.3 }
261 :     unshift @$tab, $firstrow;
262 : redwards 1.5
263 :     # start the table with the classifications if we want them
264 :     if ($cgi->param("showclassifications")) {unshift @$tab, $class1, $class2}
265 :    
266 :    
267 :    
268 :     my $emptyhtml;
269 :     if (scalar(@removed)) {
270 :     $emptyhtml="<h3>Empty Cells</h3><p>The following subsystems only contained empty cells and are not shown:<ul><li>";
271 : overbeek 1.13 $emptyhtml.=join "</li>\n<li>", map {"<a href='subsys.cgi?user=$user&ssa_name=$_&request=show_ssa&can_alter=&check=&sort=by_phylo&show_clusters=1' target='_blank'>$label{$_}</a>\n"} @removed;
272 : redwards 1.5 $emptyhtml.="</li></ul>\n";
273 :     }
274 : redwards 1.3
275 : redwards 1.1 push @$html,
276 :     "<center><h2>Subsystem Vectors</h2></center>",
277 : redwards 1.7 $cgi->start_form, $cgi->hidden('user'), $cgi->hidden('showempty'), $cgi->hidden('showclassifications'), "\n",
278 : redwards 1.2 &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"), "\n",
279 : redwards 1.5 $cgi->p($emptyhtml),
280 :     $cgi->p("You may sort by an individual column by picking it using the radio buttons, or you may sort by one of these options",
281 :     $cgi->popup_menu(-name => 'sortby', -value => ['','by_phylo','by_tax_id'], -labels => {"by_phylo"=>"Phylogeny", "by_tax_id"=>"Taxonomic ID"}, -default=>''));
282 :    
283 :     unless ($cgi->param('nmpdr')) {
284 :     push @$html, $cgi->p("You can modify your selected genomes:<br>", $raelib->scrolling_org_list($cgi, 1)),
285 :     $cgi->p("You can modify your selected subsystems:<br>", $raelib->scrolling_subsys_list($cgi, 1)),
286 :     }
287 :     push @$html, $cgi->p, $cgi->submit, $cgi->reset,
288 : redwards 1.1 $cgi->end_form;
289 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3