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

Annotation of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 :     if ($cgi->param('korgs') && $cgi->param('subsystems'))
57 :     {
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 :     $cgi->p("Please choose some organisms from the list. You can choose more than one organism:"),
76 :     $raelib->scrolling_org_list($cgi, 1),
77 :     $cgi->p("Please choose some subsystems from the list. You can choose more than one subsystem."),
78 :     $raelib->scrolling_subsys_list($cgi, 1),
79 : redwards 1.5 $cgi->p, $cgi->checkbox(-name=>'showempty', -label=>"Show empty columns"), $cgi->p,
80 :     $cgi->checkbox(-name=>'showclassifications', -checked=>1, -label=>"Show classifications"), $cgi->p;
81 : redwards 1.3
82 :     # just define the sort order
83 :     my $c=1;
84 :     foreach my $s (sort {uc($a) cmp uc($b)} $fig->all_subsystems) {push @$html, $cgi->hidden("sort$s", $c); $c++}
85 :    
86 : redwards 1.5 push @$html, $cgi->submit, $cgi->reset, $cgi->end_form;
87 : redwards 1.1 return $html;
88 :     }
89 :    
90 :     sub show_table {
91 :     my ($fig,$cgi,$html)=@_;
92 :     # what genomes are we interested in?
93 :     my @genomes=$cgi->param('korgs');
94 :     # and subsystems
95 : redwards 1.5 my @ss=$cgi->param('subsystems');
96 : redwards 1.1 # go through the subsystems and get the variant codes
97 :     # 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
98 :     # genome by genome and not col by col
99 : redwards 1.5 my $vc; my $class;
100 : redwards 1.1 foreach my $ss (@ss) {
101 :     my $subsystem=$fig->get_subsystem($ss);
102 : redwards 1.5 $vc->{$ss}=undef; # this is so the keys later on work fine
103 : redwards 1.1 foreach my $gen (@genomes) {
104 : redwards 1.5 if (defined $subsystem->get_variant_code_for_genome($gen)) {$vc->{$ss}->{$gen}=$subsystem->get_variant_code_for_genome($gen)};
105 :     }
106 :     $class->{$ss}=$fig->subsystem_classification($ss);
107 :     unless ($class->{$ss}->[0]) {$class->{$ss}=["Unclassified", '']}
108 :     print STDERR "$ss\t", $class->{$ss}->[0], "\n";
109 :     }
110 :    
111 :     # now we want to remove any subsystem that is entirely blank
112 :     my @removed;
113 :     unless ($cgi->param('showempty')) {
114 :     foreach my $ss (keys %$vc) {
115 :     my $keep=0;
116 :     foreach my $gen (keys %{$vc->{$ss}}) {
117 :     if (exists $vc->{$ss}->{$gen}) {$keep=1; last}
118 :     }
119 :     next if ($keep);
120 :     # if we get here the column is empty, so we delete the ss, and put it in @removed.
121 :     push @removed, $ss;
122 :     delete $vc->{$ss};
123 : redwards 1.1 }
124 :     }
125 : redwards 1.5
126 : redwards 1.1
127 : redwards 1.5 my @labels=$raelib->subsys_names_for_display(@ss);
128 :     my %label;
129 :     foreach my $i (0 .. @ss) {$label{$ss[$i]}=$labels[$i]}
130 :    
131 :     # sort the columns in the appropriate way
132 :     @ss=sort {
133 :     uc($class->{$a}->[0]) cmp uc($class->{$b}->[0]) ||
134 :     uc($class->{$a}->[1]) cmp uc($class->{$b}->[1])
135 :     } keys %$vc;
136 : redwards 1.1
137 :     # now generate the table header
138 : redwards 1.5 my $col_hdrs=["Genome ID", "Organism"];
139 :    
140 :     # note the first two columns are now put in later, when we merge things.
141 :     #my $class1=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
142 :     #my $class2=[]; # note that the first 2 cols of class2 is from the rowspan in the previous line
143 :    
144 :     my $class1=[];
145 :     my $class2=[];
146 : redwards 1.1
147 : redwards 1.5 my $i=2;
148 :     foreach my $ss (@ss) {
149 :     push @$col_hdrs, "<a href='FIG/subsys.cgi?user=$user&subsys=$ss target=\"_blank\"'>$label{$ss}</a>";
150 :     push @$class1, ($class->{$ss}->[0] or "Unclassified");
151 :     push @$class2, ($class->{$ss}->[1] or '');
152 :     $i++;
153 : redwards 1.1 }
154 :    
155 : redwards 1.5 # merge adjacent columns that are the same. We use a temp array to hold the data while we do this
156 :     my $temp=[["Classification", "td colspan=2 rowspan=2 valign=center style='text-align: center'"]];
157 :     my $i=0;
158 :     while ($i<=$#$class1) {
159 :     my $colspan=1;
160 :     while ($i <= $#$class1 && $class1->[$i] eq $class1->[$i+1]) {$colspan++; $i++}
161 :     push @$temp, [$class1->[$i], "td colspan=$colspan style='text-align: center'"];
162 :     $i++;
163 :     }
164 :     $class1=$temp;
165 :     # do the same thing for the bottom column
166 :     $temp=[];
167 :     my $i=0;
168 :     while ($i<=$#$class2) {
169 :     my $colspan=1;
170 :     while ($i <= scalar(@$class2) && $class2->[$i] eq $class2->[$i+1]) {$colspan++; $i++}
171 :     push @$temp, [$class2->[$i], "td colspan=$colspan style='text-align: center'"];
172 :     $i++;
173 :     }
174 :     $class2=$temp;
175 :    
176 : redwards 1.1 my $tab=[];
177 : redwards 1.5 # finally build the table
178 : redwards 1.1 foreach my $gen (@genomes) {
179 :     my $row=[
180 :     [$gen, "td class='genomeid'"],
181 :     [$fig->genus_species($gen), "td class='genus_species'"]
182 :     ];
183 :     foreach my $ss (@ss) {
184 : redwards 1.5 if (exists $vc->{$ss}->{$gen}) {
185 :     push @$row, [$vc->{$ss}->{$gen}, "td class='".${ss}."_".$vc->{$ss}->{$gen}."' style='text-align: center'"];
186 :     }
187 :     else {
188 :     push @$row, " &nbsp; ";
189 :     }
190 : redwards 1.1 }
191 :     push @$tab, $row;
192 :     }
193 :    
194 :     my $sort=$cgi->param('sortby');
195 :     if ($sort =~ /^\d+$/) {
196 :     # sort by a column number
197 :     # all columns are refs to arrays, so we sort on the first element in the ref that defines the cell.
198 :     # we sort on the $sort value which is the name of the column.
199 :     # and we sort the rows of the table as $a and $b
200 :     @$tab=sort {$a->[$sort]->[0] cmp $b->[$sort]->[0]} @$tab;
201 :     }
202 :     elsif ($sort eq "by_phylo")
203 :     {
204 :     # stolen from subsys.cgi
205 :     $tab = [map { $_->[0] }
206 :     sort { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
207 :     map { [$_, $fig->taxonomy_of($_->[0]->[0])] }
208 :     @$tab];
209 :     }
210 :     elsif ($sort eq "by_tax_id")
211 :     {
212 : redwards 1.5 $tab = [sort {$a->[0] <=> $b->[0]} @$tab];
213 : redwards 1.1 }
214 :    
215 : 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
216 :     #now add a radio button column to allow sorting of rows by column
217 :     my $sortcol=["<b>Sort by column</b>", "<input type='radio' name='sortby' value='1'>"];
218 :     foreach my $i (2..$#ss+2) {push @$sortcol, "<input type='radio' name='sortby' value='$i'>"}
219 :     unshift @$tab, $sortcol;
220 :    
221 :     # we want to add the first line of the table which has the default sort order
222 : redwards 1.3 my $firstrow=[['<b>Column Order</b>', 'td colspan=2 style="text-align: center"']];
223 :     for (my $i=0; $i<scalar(@ss); $i++) {
224 : redwards 1.4 push @$firstrow, [$cgi->textfield(-name=>"sort$ss[$i]", -size=>4, -default=>$i+1, -override=>1), "td style='text-align: center'"];
225 : redwards 1.3 }
226 :     unshift @$tab, $firstrow;
227 : redwards 1.5
228 :     # start the table with the classifications if we want them
229 :     if ($cgi->param("showclassifications")) {unshift @$tab, $class1, $class2}
230 :    
231 :    
232 :    
233 :     my $emptyhtml;
234 :     print STDERR "Removed contains ", scalar(@removed), " entries\n";
235 :     if (scalar(@removed)) {
236 :     $emptyhtml="<h3>Empty Cells</h3><p>The following subsystems only contained empty cells and are not shown:<ul><li>";
237 :     $emptyhtml.=join "</li>\n<li>", @removed;
238 :     $emptyhtml.="</li></ul>\n";
239 :     }
240 : redwards 1.3
241 : redwards 1.1 push @$html,
242 :     "<center><h2>Subsystem Vectors</h2></center>",
243 : redwards 1.2 $cgi->start_form, $cgi->hidden('user'),
244 :     &HTML::make_table($col_hdrs, $tab, "Subsystem Version Codes"), "\n",
245 : redwards 1.5 $cgi->p($emptyhtml),
246 :     $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",
247 :     $cgi->popup_menu(-name => 'sortby', -value => ['','by_phylo','by_tax_id'], -labels => {"by_phylo"=>"Phylogeny", "by_tax_id"=>"Taxonomic ID"}, -default=>''));
248 :    
249 :     unless ($cgi->param('nmpdr')) {
250 :     push @$html, $cgi->p("You can modify your selected genomes:<br>", $raelib->scrolling_org_list($cgi, 1)),
251 :     $cgi->p("You can modify your selected subsystems:<br>", $raelib->scrolling_subsys_list($cgi, 1)),
252 :     }
253 :     push @$html, $cgi->p, $cgi->submit, $cgi->reset,
254 : redwards 1.1 $cgi->end_form;
255 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3