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

Annotation of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3