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

Annotation of /FigWebServices/subsys_vectors.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3